topic Re: SelectByPolygon Method (ActiveX) Selectselection set , select all region (objects inside polyline points) in VBA Forum

SelectByPolygon Method (ActiveX) Selectselection set , select all region (objects inside polyline points)

jalal.mousa — Fri, 03 Mar 2023 15:56:28 GMT

Hi There,

i have a code that select/set closed polyline and once i extract coordinates i am trying to set selection set but i am getting nothing in line selectionSet.SelectByPolygon acSelectionSetWindowPolygon, pointsArray

i have not copied the entire code so some definitions maybe missing (please ignore)

Dim selectionSet As AcadSelectionSet ' Selection set to store the selected objects Dim AktIDPt As Variant 'Dim MyDWG As AcadDocument Dim AcadApp As Object Dim AcadDoc As Object Dim ThisDrawing As Object On Error GoTo ErrorHandler Set MyApp = GetObject(, "Autocad.Application") ErrorHandler: If Err.Description <> "" Then Err.Clear Set MyApp = CreateObject("Autocad.Application") End If MyApp.Visible = True Set MyDWG = MyApp.ActiveDocument Dim index As Integer Dim ent As AcadEntity Dim PL, Pl_Save As AcadLWPolyline Dim points As Variant MyDWG.Utility.GetEntity ent, pp, "Select Tile / Shpae must be polyline: " If TypeOf ent Is AcadLWPolyline Then If ent .closed = True Then Set PL = ent End If Dim v As Variant v = PL.Coordinates Dim i As Integer L = UBound(v) index = 0 For i = 0 To UBound(v) Step 2 points(index) = v(i) points(index + 1) = v(i + 1) points(index + 2) = 0 index = index + 3 Next points(index) = points(0) points(index + 1) = points(1) points(index + 2) = 0 savepoints = points End If Set selectionSet = MyDWG.SelectionSets.Add("MySelectionSet") Dim mode As Integer Dim pointsArray() As Double mode = acSelectionSetWindowPolygon pointsArray = points selectionSet.SelectByPolygon acSelectionSetWindowPolygon, pointsArray

**Moderator edit: Moved code to code window. Please use the </> button to access the code window.

Re: SelectByPolygon Method (ActiveX) Selectselection set , select all region (objects inside polyline points)

Ed__Jobe — Fri, 03 Mar 2023 16:57:22 GMT

You're forgetting basic selection procedures, the difference between a selection window and a crossing window. Help for the SelectByPolygon method explains that you want to use the acSelectionSetCrossingPolygon constant.

Re: SelectByPolygon Method (ActiveX) Selectselection set , select all region (objects inside polyline points)

jalal.mousa — Wed, 08 Mar 2023 18:06:26 GMT

Hi Ed,

hope you can help me i am getting error "object variable or with block variable not set" for line

selectionSet.SelectByPolygon mode, pointsArray

i Noticed that first time it runs it return values see screen shot Selection set, does that means i need to delete selection set everytime it runs ?

point Array have value see screen shot attached

also autocad attached

are you able to advise what is the issue. below full updated code i am using

Sub Get_List_of_regions_in_Room()

Dim Test As Boolean
Dim selectionSet As AcadSelectionSet ' Selection set to store the selected objects
Dim Flooringshape1 As AcadEntity
Dim sarea As Double
Dim Slength As Double
Dim ent As AcadEntity
Dim MyDWG As AcadDocument
Dim pp As AcadLWPolyline
Dim pointsArray() As Double
Dim index As Integer
Dim Flooringshape As AcadEntity

Dim PL, Pl_Save As AcadLWPolyline

On Error GoTo ErrorHandler
Set MyApp = GetObject(, "Autocad.Application")
ErrorHandler:
If Err.Description <> "" Then

Err.Clear
Set MyApp = CreateObject("Autocad.Application")
End If
MyApp.Visible = True
Set MyDWG = MyApp.ActiveDocument

' select poly Line
MyDWG.Utility.GetEntity ent, pp, "Select Tile / Shpae must be polyline: "

If TypeOf ent Is AcadLWPolyline Then

If ent.closed = True Then
Set Room = ent
End If
End If

Set Flooringshape1 = Room
Test = True
If TypeOf Flooringshape1 Is AcadCircle Then
Set Floorcircle = Flooringshape
circleCen(0) = Floorcircle.center(0)
circleCen(1) = Floorcircle.center(1)

circleRad = Floorcircle.radius

ElseIf TypeOf Flooringshape1 Is AcadLWPolyline Then

If Flooringshape1.closed = True Then
Set PL = Flooringshape1

sarea = PL.area
Slength = PL.Length

ReDim points(UBound(PL.Coordinates) + (UBound(PL.Coordinates) + 1) / 2 + 3) As Double
ReDim savepoints(UBound(PL.Coordinates) + (UBound(PL.Coordinates) + 1) / 2 + 3) As Double
Dim Roompoints() As Double

'Dim v As Variant
v = PL.Coordinates
End If
Dim i As Integer
L = UBound(v)

index = 0
For i = 0 To UBound(v) Step 2
points(index) = v(i)
points(index + 1) = v(i + 1)
points(index + 2) = 0

index = index + 3
Next
points(index) = points(0)
points(index + 1) = points(1)
points(index + 2) = 0

savepoints = points

End If

On Error Resume Next
Set selectionSet = MyDWG.SelectionSets.Add("MySelectionSet")
If Err Then
Err.Clear
Else
selectionSet.Delete
End If

'Set selectionSet = MyDWG.SelectionSets.Add("TEST_SSET2")
Set selectionSet = MyDWG.SelectionSets.Add("MySelectionSet")

Dim mode As Integer
Dim j As Integer
j = ((UBound(v) + 1) / 2 + 1) * 3 - 1
ReDim Preserve pointsArray(0 To j) As Double
'ReDim Roompoints(0 To j) As Double

mode = acSelectionSetCrossingPolygon
pointsArray = savepoints
'For i = 0 To j
'Roompoints(i) = pointsArray(i)
'Next i

pointsArray = points

selectionSet.SelectByPolygon mode, pointsArray
'selectionSet.SelectByPolygon mode, Roompoints

MsgBox Err.Description
End Sub

Re: SelectByPolygon Method (ActiveX) Selectselection set , select all region (objects inside polyline points)

Ed__Jobe — Wed, 08 Mar 2023 18:38:10 GMT

First, please use the </> button to paste your code into a code window. It's hard to read as plain text and looses it formatting.

You can't add a selectionset if it already exists. A method or function should only do one thing. If you try to do too many tasks in the same method inline with the rest of your code, it will be hard to troubleshoot and you will waste effort duplicating code. If you don't develop good programming habits, you will continuously run into error like this. For example, you will often need to select objects, so create a function that does only that and reuse it. Your use of On Error Resume Next is masking the error that the selectionset already exists. Since you get an error, your Set statement fails. You don't need to delete the ss, a good function would just return the existing ss if it already exists.

Public Function AddSelectionSet(SetName As String) As AcadSelectionSet ' This routine does the error trapping neccessary for when you want to create a ' selectin set. It takes the proposed name and either adds it to the selectionsets ' collection or sets it. On Error Resume Next Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName) If Err.Number <> 0 Then Set AddSelectionSet = ThisDrawing.SelectionSets.Item(SetName) AddSelectionSet.Clear End If End Function

Same problem with trying to get an instance of acad. Keep it in a separate function. When you use On Error Resume Next, it remains in effect until you use On Error GoTo 0. If you don't, you'll never know where other errors are coming from. That's why it's beneficial to keep your code modular, for troubleshooting, you limit errors to the scope of one method.

Public Function GetAcad(Optional ver As String) As AcadApplication ' support multiple acad versions. 'Sample ver for AutoCAD 2023 ' ".24.2" On Error Resume Next Dim acApp As AcadApplication Dim clsid As String clsid = "AutoCAD.Application" If Not ver = "" Then clsid = clsid & ver End If Set acApp = GetObject(, clsid) If acApp Is Nothing Then Set acApp = CreateObject(clsid) End If Set GetAcad = acApp End Function