AutoCAD VBA xdata的使用+水泵性能曲线VBA绘制程序

时间:2021-09-12 19:39:17

用处:比如,给一个文字设置xdata标识,然后根据需要用VBA修改文字的值,而不是在图形中增加一个mtext

AutoCAD VBA xdata的使用+水泵性能曲线VBA绘制程序AutoCAD VBA xdata的使用+水泵性能曲线VBA绘制程序
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
View Code

 

dwg文件:http://pan.baidu.com/s/1bp5r3CN

如果你是水泵行业的,下面这个绘制性能曲线的程序可能会有点参考价值:

http://pan.baidu.com/s/1dFEGO6H

AutoCAD VBA xdata的使用+水泵性能曲线VBA绘制程序

 ……

mtext的背景遮罩MTextObj.BackgroundFill只能设置有无遮罩,不能设置边距,请路过的高手指点迷津!