【源代码】删除绑定在图元上的扩展数据

Public Sub ClearXData(Obj As AcadObject, Optional RegApp As String = "")
    Const regAppKey As Integer = 1001
    Const acadApp As String = "ACAD"
    
    Dim XDType As Variant
    Dim XDData As Variant
    Dim NewType(0) As Integer
    Dim NewData(0) As Variant
    Dim i As Integer
    
    Obj.GetXData AppName:=RegApp, XDataType:=XDType, XDataValue:=XDData
    
    If Not IsEmpty(XDType) Then
        For i = LBound(XDType) To UBound(XDType)
            If XDType(i) = regAppKey Then
                If Not XDData(i) Like acadApp Then
                    NewType(0) = regAppKey
                    NewData(0) = XDData(i)
                    Obj.setXdata XDataType:=NewType, XDataValue:=NewData
                End If
            End If
        Next i
    End If
End Sub