I'm trying to replace all attribute definitions in modelspace with text. The following code replaces all the attributes with text, but for some reason moves some of them to 0,0,0. Anyone have any ideas?
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