Cad vba——输出dwg所有图层实体数量

Sub CountEntitiesByLayerAndType()
'yngqq@2024年8月27日09:22:15
    ' 定义一个嵌套字典对象
   ' Dim layerDict As Scripting.Dictionary
    'Set layerDict = New Scripting.Dictionary
   Set layerDict = CreateObject("scripting.dictionary")
    ' 遍历当前图形中的所有实体
    Dim entity As AcadEntity
    For Each entity In ThisDrawing.ModelSpace
       
        ' 获取实体的图层和类型
        Dim layerName As String
        Dim entityType As String
        layerName = entity.Layer
        entityType = TypeName(entity)
       
        ' 如果图层在字典中不存在，添加图层作为新键
        If Not layerDict.Exists(layerName) Then
            'Dim typeDict As Scripting.Dictionary
            'Set typeDict = New Scripting.Dictionary
           Set typeDict = CreateObject("scripting.dictionary")
            layerDict.Add layerName, typeDict
        End If
       
        ' 获取该图层的类型字典
        Set typeDict = layerDict(layerName)
       
        ' 如果该类型在类型字典中不存在，添加类型作为新键
        If typeDict.Exists(entityType) Then
            typeDict(entityType) = typeDict(entityType) + 1
        Else
            typeDict.Add entityType, 1
        End If
       
    Next entity
   
    ' 输出结果
    Dim layerKey As Variant
    Dim typeKey As Variant
    For Each layerKey In layerDict.Keys
        ThisDrawing.Utility.Prompt vbCrLf & "图层: " & layerKey & vbCrLf
        Set typeDict = layerDict(layerKey)
        For Each typeKey In typeDict.Keys
            ThisDrawing.Utility.Prompt "   实体类型: " & typeKey & " 数量: " & typeDict(typeKey) & vbCrLf
        Next typeKey
        ThisDrawing.Utility.Prompt "===================================" & vbCrLf
    Next layerKey
    MsgBox "OK，CAD二次开发qq:443440204", , "qq443440204"
End Sub