代理实体

Sub Apps()
    Dim App As AcadRegisteredApplication
    For Each App In ThisDrawing.RegisteredApplications
        Debug.Print App.Name
        DeleteApplicationXData App.Name
    Next
End Sub
'Cadvault
Public Function DeleteApplicationXData(strAppName As String) As Boolean
    Dim objSelSet As AcadSelectionSet
    Dim objSelCol As AcadSelectionSets
    Dim objEnt As AcadEntity
    Dim intXData(0) As Integer
    Dim varXData(0) As Variant
    Dim varData(0) As Variant
    Dim intData(0) As Integer
    On Error GoTo Err_Control
    Set objSelSet = ThisDrawing.PickfirstSelectionSet
    intData(0) = 1001
    varData(0) = strAppName
    objSelSet.Select 5, FilterType:=intData, FilterData:=varData
    For Each objEnt In objSelSet
        objEnt.SetXData intData, varData
    Next objEnt
    objSelSet.Delete
    DeleteApplicationXData = True
Exit_Here:
    Exit Function
Err_Control:
    Select Case Err.Number
        Case Else
        MsgBox Err.Description
        Resume Exit_Here
    End Select
End Function

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