删除具有匹配属性/图层/视觉状态的动态块的选择集

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