我正在尝试用文本替换模型空间中的所有属性定义。下面的代码将所有属性替换为文本,但由于某种原因,其中一些属性移动到 0,0,0。有人有什么想法吗?
-
- 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
本帖以下内容被隐藏保护;需要你回复后,才能看到! 游客,如果您要查看本帖隐藏内容请 回复 |