用文本替换属性定义。

Public Sub remove_attdef()
    Dim SelSet As AcadSelectionSet
    Dim AT As AcadAttribute
    Dim FilterType(0 To 0) As Integer
    Dim FilterData(0 To 0) As Variant
    Dim TXT As AcadText
    Dim YesNo
    'select attribute definitions
    FilterType(0) = 0
    FilterData(0) = "ATTDEF"
    On Error GoTo Exit_Error
        ThisDrawing.SelectionSets.Add "SelSet"
        Set SelSet = ThisDrawing.SelectionSets("SelSet")
        SelSet.Clear
    SelSet.Select acSelectionSetAll, , , FilterType, FilterData
    'if the count is greater than 1 then there are attribute definitions in
modelspace
    If SelSet.Count  0 Then
        YesNo = MsgBox("You Have " & SelSet.Count & " Attribute
Definition(s) in " & ThisDrawing.Name & ". This Program will attempt to
convert them to Text.", _
        vbYesNo + vbCritical + vbDefaultButton1)
        'if "Ok" is pressed then try to replace all of the attribute
definitions with text that has the same properties.
        If YesNo = vbYes Then
            For Each AT In SelSet
                Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString,
AT.InsertionPoint, AT.Height)
                TXT.Alignment = AT.Alignment
                TXT.Layer = AT.Layer
                TXT.Color = AT.Color
                TXT.Rotation = AT.Rotation
                TXT.Update
                AT.Delete
            Next
        End If
    End If
    'clear the selection set
    SelSet.Clear
    'rescan the drawing for attribute definitions
    SelSet.Select acSelectionSetAll, , , FilterType, FilterData
    'if it the count is zero then it worked.
    If SelSet.Count = 0 Then
        MsgBox "All attributes were converted to text."
    Else:
        MsgBox "Failed to convert all attributes to text."
    End If
Exit_Error:
   SelSet.Delete
   Set SelSet = Nothing
   Set AT = Nothing
   Set TXT = Nothing
End Sub

Dim insertionZero(0 To 2) As Double
insertionZero(0) = 0: insertionZero(1) = 0: insertionZero(2) = 0
TXT.Move insertionZero, AT.InsertionPoint

           For Each AT In SelSet 
                Set TXT = ThisDrawing.ModelSpace.AddText(AT.TagString, 
AT.InsertionPoint, AT.Height) 
                TXT.Alignment = AT.Alignment 
                TXT.TextAlignmentPoint = AT.TextAlignmentPoint
                TXT.Layer = AT.Layer 
                TXT.Color = AT.Color 
                TXT.Rotation = AT.Rotation 
                TXT.Update 
                AT.Delete 
            Next