Here is my solution for one block. You can call it in a loop or modify it to suit your needs. As is, you would call it like this:
Dim mySS As AcadSelectionSet
mySS = GetSS_BlockName("myblock")
Public Function GetSS_BlockName(BlockName As String) As AcadSelectionSet
'creates a ss of blocks with the name supplied in the argument
Dim s2 As AcadSelectionSet
Set s2 = AddSelectionSet("ssBlocks") ' create ss with a name
s2.Clear ' clear the set
Dim intFtyp(3) As Integer ' setup for the filter
Dim varFval(3) As Variant
Dim varFilter1, varFilter2 As Variant
intFtyp(0) = -4: varFval(0) = "<AND"
intFtyp(1) = 0: varFval(1) = "INSERT" ' get only blocks
intFtyp(2) = 2: varFval(2) = BlockName ' whose name is specified in argument
intFtyp(3) = -4: varFval(3) = "AND>"
varFilter1 = intFtyp: varFilter2 = varFval
s2.Select acSelectionSetAll, , , varFilter1, varFilter2 ' do it
Set GetSS_BlockName = s2
End Function
Another option would be to use the following function:
Public Sub BuildFilter(typeArray As Variant, dataArray As Variant, ParamArray gCodes())
'Purpose
'Fills a pair of variants with arrays for use as a selection set filter
'
'Arguments
'Two variants (not variant arrays) and an unlimited number of group code / value pairs
'
'Example
'BuildFilter fType, fData, 0, "LINE", 7, "WALLS"
Dim fType() As Integer, fData()
Dim index As Long, i As Long
index = LBound(gCodes) - 1
For i = LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve fType(0 To index)
ReDim Preserve fData(0 To index)
fType(index) = CInt(gCodes(i))
fData(index) = gCodes(i + 1)
Next
typeArray = fType: dataArray = fData
End Sub
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
When building a filter, you can't simply concatenate strings. In your example, it would be searching for a single block named "testBlock1textBlock2testBlock3". You have to logically group multiple conditions using AND or OR.
You can call the above function like this:
Dim SS As AcadSelectionSet
Dim aryType As Variant
Dim arydata As Variant
Set SS = AddSelectionSet("findBlocks")
BuildFilter aryType, arydata, -4, "<AND", 0, "INSERT", -4, "<OR", 2, "testBlock1", 2, "testBlock2", 2, "testBlock3", -4, "OR>", -4, "AND>"
SS.Clear
SS.Select acSelectionSetAll, , , aryType, arydata
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to
post your code.