用处:比如,给一个文字设置xdata标识,然后根据需要用VBA修改文字的值,而不是在图形中增加一个mtext
Sub Ch10_AttachXDataToSelectionSetObjects() ' 创建选择集 Dim sset As Object Set sset = ThisDrawing.SelectionSets.Add("SS1") ' 提示用户选择对象 sset.SelectOnScreen ' 定义扩展数据 Dim appName As String, xdataStr As String appName = "MY_APP" xdataStr = "流量" Dim xdataType(0 To 1) As Integer Dim xdata(0 To 1) As Variant ' 为每个数组定义值 ' 1001 指示 appName xdataType(0) = 1001 xdata(0) = appName ' 1000 指示字符串值 xdataType(1) = 1000 ' xdata(1) = xdataStr ' 遍历选择集中的所有图元 ' 将扩展数据设置和指定给每个图元 Dim ent As Object For Each ent In sset xdata(1) = ent.TextString ent.SetXData xdataType, xdata Next ent sset.Clear ThisDrawing.SelectionSets("SS1").Delete End Sub Sub Ch10_ViewXData() ' 创建选择集 Dim sset As Object Set sset = ThisDrawing.SelectionSets.Add("SS2") ' 提示用户选择对象 sset.SelectOnScreen ' 定义扩展数据变量以保存扩展数据信息 Dim xdataType As Variant Dim xdata As Variant Dim xd As Variant ' 定义索引计数器 Dim xdi As Integer xdi = 0 ' 遍历选择集中的对象 ' 并检索对象的扩展数据 Dim msgstr As String Dim appName As String Dim ent As AcadEntity appName = "MY_APP" For Each ent In sset msgstr = "" xdi = 0 ' 检索 appName 扩展数据类型和值 ent.GetXData appName, xdataType, xdata ' 如果未初始化 xdataType 变量, ' 则没有可供该图元检索的 appName 扩展数据 If VarType(xdataType) <> vbEmpty Then For Each xd In xdata msgstr = msgstr & vbCrLf & xdataType(xdi) _ & ": " & xd & "=" & xdata(xdi) xdi = xdi + 1 Next xd End If ' 如果 msgstr 变量为 NULL,则没有扩展数据 If msgstr = "" Then msgstr = vbCrLf & "NONE" MsgBox appName & " xdata on " & ent.ObjectName & _ ":" & vbCrLf & msgstr Next ent sset.Clear ThisDrawing.SelectionSets("SS2").Delete End Sub
dwg文件:http://pan.baidu.com/s/1bp5r3CN
如果你是水泵行业的,下面这个绘制性能曲线的程序可能会有点参考价值:
http://pan.baidu.com/s/1dFEGO6H
……
mtext的背景遮罩MTextObj.BackgroundFill只能设置有无遮罩,不能设置边距,请路过的高手指点迷津!