I've got some code I've been working on (see below) that allows the user to select a dynamic block. The program then grabs the blocks effective name, visibility state, attributes (if any) and layer. From there I was hoping to create a selection set of blocks that have those same characteristics. Now, what I've got so far will create a selection set of blocks with the same layer name. I was wondering if there's a way to use filters (similar to below) to set the visibility state, effective name and attribute rather than looping through all of the objects within the selection set and testing if they have any of these characteristics.
FilterType(0) = 0
FilterData(0) = "Insert"
FilterType(1) = 8
FilterData(1) = strBlkLayerName
Set sset = vbdPowerSet("BlockCountBySelection")
sset.Select acSelectionSetAll, , , FilterType, FilterData
Complete code...
Option Explicit
Public Sub Main()
Dim sset As AcadSelectionSet
Dim Entity As AcadEntity
Dim Point As Variant
Dim objDynBlk As AcadBlockReference
Dim vDynProps As Variant
Dim oDynProp As AcadDynamicBlockReferenceProperty
Dim i As Integer
Dim strVisState As String
Dim varAtts() As AcadAttributeReference
Dim intAttVal As Integer
Dim strAttValue As String
Dim retVal As Long
Dim strDynBlkName As String
Dim FilterType(1) As Integer
Dim FilterData(1) As Variant
Dim strBlkLayerName As String
ThisDrawing.Utility.GetEntity Entity, Point, "Select a block: "
If TypeOf Entity Is AcadBlockReference Then
Set objDynBlk = Entity
If objDynBlk.IsDynamicBlock = True Then
strBlkLayerName = objDynBlk.Layer
If objDynBlk.EffectiveName Like "MY_DB_*" Then
strDynBlkName = objDynBlk.EffectiveName
vDynProps = objDynBlk.GetDynamicBlockProperties
For i = 0 To UBound(vDynProps)
Set oDynProp = vDynProps(i)
If oDynProp.PropertyName = "Visibility" Then
strVisState = oDynProp.Value
End If
Next i
If objDynBlk.HasAttributes = True Then
varAtts = objDynBlk.GetAttributes
For intAttVal = 0 To UBound(varAtts)
If UCase(varAtts(intAttVal).TagString) = "DATATYPE" Then
strAttValue = varAtts(intAttVal).TextString
Else
strAttValue = Null
End If
Next intAttVal
End If
retVal = MsgBox("Do you want to continue and delete all blocks with the following characteristics?" & vbCrLf & _
vbCrLf & _
"Block Name: " & strDynBlkName & vbCrLf & _
"Visibility State: " & strVisState & vbCrLf & _
"Attribute: " & strAttValue & vbCrLf & _
"Layer Name: " & strBlkLayerName, vbQuestion + vbYesNo, "Continue...")
Select Case retVal
Case Is = vbNo
Exit Sub
Case Is = vbYes
FilterType(0) = 0
FilterData(0) = "Insert"
FilterType(1) = 8
FilterData(1) = strBlkLayerName
Set sset = vbdPowerSet("BlockCountBySelection")
sset.Select acSelectionSetAll, , , FilterType, FilterData
End Select
Else
MsgBox "NOT a dynamic block!"
End If
End If
Else
MsgBox "The selected object is NOT a block."
End If
End Sub
Public Function vbdPowerSet(strName As String) As AcadSelectionSet
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Set objSelCol = ThisDrawing.SelectionSets
For Each objSelSet In objSelCol
If objSelSet.Name = strName Then
objSelSet.Delete
Exit For
End If
Next
Set objSelSet = ThisDrawing.SelectionSets.Add(strName)
Set vbdPowerSet = objSelSet
End Function