←  Technical Questions

nanoCAD forum

»

Nanocad by Excel VBA - select by internal...

andreguidelli's Photo andreguidelli 29 Mar 2019

Hello. I'm starting to do some automation with nanocad activex using excel VBA to control the drawing.
This uses OdaX and Ncauto dll libraries

I'm actually trying to make a Hatch in a certain region using "ModelSpace.AddHatch" method.

i'll try to describe the problem here (simplified).

Attached Image

I have drawn a rectangle that has 1 point in origin (0,0,0), and the other corner's points will always be positive or 0. i have a horizontal line crossing this rectangle, diving it in 2 regions (the rectangle polyline still the same).
*The dimensions of the rectangle may vary, but it'll be at least a 25mm square.
* Rectangle lines will always be parallel to the origin axis.
* The horizontal line will always be parallel to the X axis.
* The horizontal line will be at least 10mm distant from the bottom or upper lines of the rectangle.

the problem is.. in my real problem I'll not know where this line will be drawn (too hard to detect) (just take it as hypothesis). But I still need to make a Hatch in the lower part of the rectangle.

This makes creating a hatch boundary difficult.. because i need to make an array of objects to do the "AppendOuterLoop" method and close the hatch just after "ModelSpace.AddHatch" method. but i cant "make" another polyline above the under region since I don't know where the line is.

The obvious answer to me is to create a selection set by picking an internal point of this under area and then transfer it to an array of objects, because i know the points between X(1-24) and Y(1-9) will always be comprised into that region.
But I'm trying for hours to make this selection set by picking internal points to work and.. it just doesn't. if you know how You'll make my day, my week.
I'm failing in creating a selection set (the method ".SelectionSets.Add" doesn't works)

The other options i found is to make a "-boundary" command by ".SendCommand" that brings "pick by internal point" by default, but i fail to get the reference of the resultant polyline from this command. if it is possible to pass this resultant polyline to the "AppendOuterLoop" argument, it would also solve my problem (i believe).

Anyway.. I'm out of options, so if you have another way to make this that respect the above constraints, I'm open to it.

(ps. since it really looks like autocad, I'm using this site to get the references: http://entercad.ru/a....en/index.html?)


---------------------UPDATE:

I found a surprising easy way after writing this: joining both ways I described!

now I'm using ".SendCommand" to create a boundary (because there is no activex command for this) and then i create a selection set with the Last created entity (polyline from -boundary), and then this selection set turns into a region, that closes the Hatch (phew).

BUT

i can't figure out why ".select acSelectionSetPrevious" isn't working.. it gives me " RunTime Error '5' " when I try to execute.. And the same for "acSelectionSetLast"

I tried with ."SelectOnScreen" instead of ".select acSelectionSetPrevious" and it works perfectly, but it requires the user action to select. I think the problem is with this argument "acSelectionSetPrevious", but i have no idea why..

I'll post the VBA code down here for reference (in this example below, the created rectangle position is a bit different from first example, ande the line isn't horizontal.. but the challenge is the same).


'---------------------------------------------------------------------------------------------------------------------code:

Public ncadApp As nanoCAD.Application
Public ncadDoc As nanoCAD.Document
Public ncadUt As nanoCAD.Utility
Sub open_and_make_drawing()
    'Dim ncModelSpace As AcadModelSpace
    'Dim ncPaperSpace As AcadPaperSpace
    Dim CurrBook As Workbook
    Const ncModelSpace = 1
    Const ncPaperSpace = 0
    Set CurrBook = Application.ActiveWorkbook
    'Check if NanoCAD is open.
    On Error Resume Next
    Set ncadApp = GetObject("", "nanoCAD.Application")
    On Error GoTo 0
    'If NanoCAD is not opened create a new instance and make it visible.
    If ncadApp Is Nothing Then
	    Set acadApp = New nanoCAD.Application
	    acadApp.Visible = True
    End If
    'Check if there is an active drawing.
    On Error Resume Next
    Set ncadDoc = ncadApp.ActiveDocument
    On Error GoTo 0
    'No active drawing found. Create a new one.
    If ncadDoc Is Nothing Then
	    Set ncadDoc = ncadApp.Documents.Add("")
	    ncadApp.Visible = True
    End If
    Call add_line(0, 0, 500, 200)
    Call add_line(500, 200, 400, 400)
    Call add_rect_2p(300, 0, 400, 200)
    Call Example_AddHatch
    ncadApp.ZoomExtents
End Sub
Sub add_line(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
    Dim newline As AcadLine
    Dim StartPoint(0 To 2) As Double
    Dim Endpoint(0 To 2) As Double
    StartPoint(0) = x1: StartPoint(1) = y1: StartPoint(2) = 0
    Endpoint(0) = x2: Endpoint(1) = y2: Endpoint(2) = 0
    If ncadDoc.ActiveSpace = ncModelSpace Then
	    Set newline = ncadDoc.ModelSpace.AddLine(StartPoint, Endpoint)
    Else
	    Set newline = ncadDoc.ModelSpace.AddLine(StartPoint, Endpoint)
    End If
End Sub
Sub add_rect_2p(x1 As Double, y1 As Double, x2 As Double, y2 As Double)
    Dim StartPoint As String
    Dim Endpoint As String
    StartPoint = x1 & "," & y1 & ",0"
    Endpoint = x2 & "," & y2 & ",0"
    ncadDoc.SendCommand "R" & vbCr & StartPoint & vbCr & Endpoint & vbCr
End Sub

Sub Example_AddHatch()
    ' This example creates an associative gradient hatch in model space.
    Dim patternName As String
    Dim PatternType As Long
    Dim bAssociativity As Boolean
    ' Define the hatch
    patternName = "SOLID"
    PatternType = acHatchPatternTypePreDefined '0
    bAssociativity = True

ncadDoc.SendCommand "-Boundary" & vbCr & "301,101,0" & vbCr & vbCr
ncadDoc.SendCommand "select" & vbCr & "?" & vbCr & "Last" & vbCr & vbCr
ncadDoc.SendCommand "l" & vbCr & Chr(3) & Chr(3)
Dim selectionSet1 As SelectionSet
Set selectionSet1 = ncadDoc.SelectionSets.Add(Now)
Dim mode As Integer
mode = acSelectionSetPrevious
selectionSet1.Select mode
'selectionSet1.Highlight False
'selectionSet1.Update
Dim arr(0 To 0) As AcadEntity
Set arr(0) = selectionSet1.Item(0)

Dim regionObj
regionObj = ncadDoc.ModelSpace.AddRegion(arr)

Dim hatchObj As AcadHatch
    ' Create the associative Hatch object in model space
    Set hatchObj = ncadDoc.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
  ' Append the outer boundary to the hatch
  ' object, and display the hatch
  hatchObj.AppendOuterLoop (arr)
  hatchObj.Evaluate
    ncadDoc.Regen True
End Sub
Quote

andreguidelli's Photo andreguidelli 04 Apr 2019

Just for the record.. I solved my problem by myself

I still don't know why ".select acSelectionSetPrevious" isn't working, but I found another way:

>Create an Outer Boundary polyline at the selected point with SendCommand ;
>Make an array with last created entity (Boundary Polyline), acessing Modelspace.Item ;
>Create the Hatch with the created array as outer boundary .

And here is my final function (only hatch function):

Public Sub nano_AddHatch_1P(ncadDoc As nanoCAD.Document, x As Double, y As Double, patternName As String, HatchScale As Double)

	'Define the hatch
	Dim PatternType As Long
	Dim bAssociativity As Boolean
	PatternType = acHatchPatternTypePreDefined   '0
	bAssociativity = True

	'Create an Outer Boundary polyline at the selected point
	Dim insertionPnt As String
	insertionPnt = x & "," & y & ",0"
	ncadDoc.SendCommand "-Boundary" & vbCr & insertionPnt & vbCr & vbCr

	'Make an array with last created entity (Boundary Polyline)
	Dim arr(0 To 0) As AcadEntity
	Set arr(0) = ncadDoc.ModelSpace.item(ncadDoc.ModelSpace.Count - 1)

	'Create the associative Hatch object in model space
	Dim hatchObj As AcadHatch
	Set hatchObj = ncadDoc.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
	hatchObj.AppendOuterLoop (arr)		  'Append the outer boundary to the hatch object, and display the hatch
	hatchObj.Evaluate
	hatchObj.PatternScale = HatchScale	  'Scale the hatch
	hatchObj.Evaluate

	ncadDoc.Regen True
End Sub
Quote