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

[jalal.mousa]

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.

[Ed__Jobe · Accepted solution]

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.

[jalal.mousa]

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

[Ed__Jobe · Accepted solution]

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