Dim AttDef As AcadAttribute
Dim PickPnt As Variant
ThisDrawing.Utility.GetEntity AttDef, PickPnt, "请选择带属性文字:"
MsgBox ("ObjectName: " & AttDef.ObjectName & vbCrLf _
& "默认字符串: " & AttDef.TextString & vbCrLf _
& "提示字符串: " & AttDef.PromptString & vbCrLf _
& "标记字符串: " & AttDef.TagString & vbCrLf _
& "Height: " & AttDef.Height & vbCrLf _
& "Rotation: " & AttDef.Rotation & vbCrLf _
& "ScaleFactor: " & AttDef.ScaleFactor & vbCrLf _
& "StyleName: " & AttDef.StyleName & vbCrLf _
& "StyleName: " & AttDef.Layer & vbCrLf)
Dim T As AcadText
Set T = ThisDrawing.ModelSpace.AddText(AttDef.TagString, AttDef.InsertionPoint, AttDef.Height)
'T.TextString = AttDef.TagString
T.Alignment = AttDef.Alignment
'T.InsertionPoint = AttDef.InsertionPoint
T.Rotation = AttDef.Rotation
'T.Height = AttDef.Height
T.ScaleFactor = AttDef.ScaleFactor
T.StyleName = AttDef.StyleName
T.Layer = AttDef.Layer
AttDef.Delete
End Sub
Sub ClearAttdef()
Dim ObjSelected As Object
Dim AttDef As AcadAttribute
Dim AcSSet As AcadSelectionSet
On Error Resume Next
'创建选择集
Set AcSSet = ThisDrawing.SelectionSets.Add("ATTDEF")
'定义过滤机制
Dim filterType(0) As Integer
Dim filterData(0) As Variant
filterType(0) = 0
filterData(0) = "ATTDEF"
'选择
AcSSet.SelectOnScreen filterType, filterData
'对选择集中的对象进行操作
For Each AttDef In AcSSet
Dim T As AcadText
'插入一个不带属性的单行文字
Set T = ThisDrawing.ModelSpace.AddText(AttDef.TagString, AttDef.InsertionPoint, AttDef.Height)
T.Alignment = AttDef.Alignment
T.Rotation = AttDef.Rotation
T.ScaleFactor = AttDef.ScaleFactor
T.StyleName = AttDef.StyleName
T.Layer = AttDef.Layer
'删除原 带属性文字
AttDef.Delete
Next
ThisDrawing.SelectionSets.Item("ATTDEF").Delete
'MsgBox Err.Description
End Sub
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |