Select all Objects inside and crossing a closed 2D polyline using VBA

[Anonymous]

I'm trying to create a VBA routine that asks the user to select a closed 2D polyline and adds all objects (inside or crossing the polyline) to a selection set. The second part of my routine runs through all the items in the selection set, searches for specific blocks and exports them to excel for further processing. The first part is where I'm having a lot of difficulties. From what I read on other sites, using selectbypolygon should work if I convert the 2D coordinates to 3D coordinates which my routine does. The problem is that my selection set is allways empty and the last line never runs because ssetObj appears as empty. Can you help me understand what is wrong with my code bellow?

Sub test_pl()

Dim oEnt As AcadEntity
Dim Pt(0 To 2) As Double
Dim oLWP As AcadLWPolyline
Dim oP As AcadPolyline
Dim dblNewCords As Variant
Dim ssetObj As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Delete ("TEST_SSET2")

ThisDrawing.Utility.GetEntity oEnt, Pt, "Select a polyline"
Set oLWP = oEnt
dblCurCords = oLWP.Coordinates
iMaxCurArr = UBound(dblCurCords)
iMaxNewArr = ((iMaxCurArr + 1) * 1.5) - 1
ReDim dblNewCords(iMaxNewArr) As Double
iCurArrIdx = 0: iCnt = 1
For iNewArrIdx = 0 To iMaxNewArr
   If iCnt = 3 Then
      dblNewCords(iNewArrIdx) = 0
      iCnt = 1
   Else
      dblNewCords(iNewArrIdx) = dblCurCords(iCurArrIdx)
      iCurArrIdx = iCurArrIdx + 1
      iCnt = iCnt + 1
   End If
Next

Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET2")
ssetObj.SelectByPolygon acSelectionSetWindowPolygon, dblNewCords
MsgBox ssetObj.Count

End Sub

[dbroad · Accepted solution]

It works the first time through.  Selectionsets does not have a delete method. Also if you want crossing, you should probably use it.

Spoiler

Sub test_pl()

Dim oEnt As AcadEntity
Dim Pt(0 To 2) As Double
Dim oLWP As AcadLWPolyline
Dim oP As AcadPolyline
Dim dblNewCords As Variant
Dim ssetObj As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets.Item("TEST_SSET2").Delete

ThisDrawing.Utility.GetEntity oEnt, Pt, "Select a polyline"
Set oLWP = oEnt
dblCurCords = oLWP.Coordinates
iMaxCurArr = UBound(dblCurCords)
iMaxNewArr = ((iMaxCurArr + 1) * 1.5) - 1
ReDim dblNewCords(iMaxNewArr) As Double
iCurArrIdx = 0: iCnt = 1
For iNewArrIdx = 0 To iMaxNewArr
If iCnt = 3 Then
dblNewCords(iNewArrIdx) = 0
iCnt = 1
Else
dblNewCords(iNewArrIdx) = dblCurCords(iCurArrIdx)
iCurArrIdx = iCurArrIdx + 1
iCnt = iCnt + 1
End If
Next

Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET2")
ssetObj.SelectByPolygon acSelectionSetCrossingPolygon, dblNewCords
MsgBox ssetObj.Count

End Sub

[Anonymous]

The routine now works perfectly. Thank you for your help and quick reply. I added this line of code after the msgbox to see what the routine selects:

ssetObj.highlight true

The only problem with it is that I have to REGEN to clear the highlighted items. Is there a way to highlight the items without having to REGEN?

[dbroad]

Untested.  I would imagine ssetObj.highlight false

If your problem is solved, be sure to mark the post that solved it.  Otherwise, you will get automatic emails asking if your problem is solved.

[Anonymous]

I think you didn't understand what I pretend. I want the routine to select the items and clear the selection when I press the ESC key. A similar behavior to what would happen if you selected items by hand and cleared the selection by pressing the ESC key. With ".highlight true" the items stay highlighted until I REGEN.