selectionsets

I'm working on a vba macro to rotate blocks and text parallel to the nearest line or arc.

To do this i make an selectionset with all the lines and arcs in a specific layer and i make an selectionset with all the selected blocks and text.

The problem is that when i fill the second selectionset the first is empty.
How can i use 2 selectionsets

The code is below


Public SelectieBlockText As AcadSelectionSet
Public SelectieLines As AcadSelectionSet

Public Function SelBlocks() As AcadSelectionSet

If ThisDrawing.SelectionSets.Count = 0 Then
Set SelectieBlockText = ThisDrawing.SelectionSets.Add("block")
Set SelectieBlockText = ThisDrawing.SelectionSets.Add("lijn")
Else
Set SelectieBlockText = ThisDrawing.SelectionSets.Item(0)
Set SelectieLines = ThisDrawing.SelectionSets.Item(1)
End If
SelectieBlockText.Clear
SelectieLines.Clear


' lines,arc

ReDim gpCode(0 To 1) As Integer
gpCode(0) = 0
gpCode(1) = 8

ReDim dataValue(0 To 1) As Variant
dataValue(0) = "Line,Arc"
dataValue(1) = "RotateLayer"

Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue

SelectieLines.Select 5, , , groupCode, dataCode


' blocks and text
ReDim gpCode(0 To 0) As Integer
gpCode(0) = 0

ReDim dataValue(0 To 0) As Variant
dataValue(0) = "insert,text"

groupCode = gpCode
dataCode = dataValue

SelectieBlockText.SelectOnScreen groupCode, dataCode
MsgBox SelectieLines.Count & " selectie lijnen"
End Function

 

I usually do the following (not sure it's a *good* style):

On Error Resume Next
Set ss1 = ThisDrawing.SelectionSets.Add("my_selection")
Set ss1 = ThisDrawing.SelectionSets.Item("my_selection")
ss1.Clear
Err.Clear

I think your code is dangerous, because you take for granted that there are only two SelectionSets and that Item(0) has to be "block" and Item(1) has to be "lijn"

 

Looks like a copy-paste error. Compare the second and third lines.

Also, Allen's comment about assuming the index of the ss is a valid one.
There could be many ss's. The usual way to create a ss is to use a function
like:

Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping neccessary for creating selection
sets.
On Error Resume Next
Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName)
If Err.Number <> 0 Then
Set AddSelectionSet = ThisDrawing.SelectionSets.Item(SetName)
End If
End Function


--
----
Ed
----

specific layer and i make an selectionset with all the selected blocks and
text.