基于区块名称、属性值的区块计数

Private Sub GetAttributeCount()
    Dim objAttKeys As Variant
    Dim objAttItems As Variant
    Dim objAttDict As Dictionary
    Dim varAtts() As AcadAttributeReference
    Dim objBlock As AcadBlockReference
    Dim obj As AcadEntity
    Dim i, x As Integer
    
    Set objAttDict = New Dictionary
    
    x = 1
    For Each obj In SSet
        Set objBlock = obj
        If obj.HasAttributes Then
            varAtts = obj.GetAttributes
            For i = LBound(varAtts) To UBound(varAtts)
                If UCase$(varAtts(i).TagString) = "DATATYPE" Then
                    If objAttDict.Exists(varAtts(i).TextString) = False Then
                        objAttDict.Add varAtts(i).TextString, 1
                    Else
                        objAttDict.item(varAtts(i).TextString) = objAttDict.item(varAtts(i).TextString) + 1
                    End If
                End If
                On Error GoTo 0
            Next i
        End If
    Next obj
    
    i = 0
    
    objAttKeys = objAttDict.Keys
    objAttItems = objAttDict.Items
    For x = 0 To UBound(objAttKeys)
        Debug.Print objAttKeys(x) & vbTab & objAttItems(x)
        i = i + objAttItems(x)
    Next
End Sub