代理实体

Option Explicit
Public Sub Find_Proxy()
  Dim objEnt As AcadEntity
  Dim intCnt As Integer
  Dim iLp As Integer
  Dim iDx As Integer
  Dim objDic As AcadDictionary
  Dim tempObj As AcadObject
  For Each objEnt In ThisDrawing.ModelSpace
    If objEnt.HasExtensionDictionary Then
      objEnt.Color = acRed
      Set objDic = objEnt.GetExtensionDictionary
      iLp = objDic.Count
      For iDx = 0 To iLp - 1
        Set tempObj = objDic.Item(iDx)
        tempObj.Delete
      Next iDx
      intCnt = intCnt + objDic.Count
    End If
  Next objEnt
  Debug.Print intCnt
End Sub

Option Explicit
Sub main()
  scanDictionary ThisDrawing.Dictionaries
  scanTable ThisDrawing.DimStyles
  scanTable ThisDrawing.Layers
  scanTable ThisDrawing.Linetypes
  scanTable ThisDrawing.TextStyles
  scanObjects
End Sub
Sub scanDictionary(ByRef dictionary As Object)
  Dim obj As AcadObject
  For Each obj In dictionary
    If obj.ObjectName Like "AcDbZombie*" Then
      obj.Delete
    Else
      If obj.HasExtensionDictionary Then
        scanDictionary obj.GetExtensionDictionary
      End If
    End If
  Next obj
  Set obj = Nothing
End Sub
Sub scanTable(ByRef table As Object)
  Dim obj As Object
  For Each obj In table
    If obj.HasExtensionDictionary Then
      scanDictionary obj.GetExtensionDictionary
    End If
  Next obj
  Set obj = Nothing
End Sub
Sub scanObjects()
  Dim block As AcadBlock
  For Each block In ThisDrawing.Blocks
    Dim ent As AcadEntity
    For Each ent In block
      If ent.ObjectName = "AcDbZombieEntity" Then
        ent.Delete
      Else
        If ent.HasExtensionDictionary Then
          scanDictionary ent.GetExtensionDictionary
        End If
      End If
    Next ent
    Set ent = Nothing
  Next block
  Set block = Nothing
End Sub