CAD二次开发（Vba）------SETXDATA使用

首先发一下组码值类型查询网址和按数字次序排列的组码

大家可以参考按数字次序排列的组码进行XDATA的设置

通过以下两组代码大家一定要注意在使用xdata时，首先的组码值类型一定要是1001，定义你的扩展数据的注册应用程序名，后面的组码值类型也要和你的组码值相对应。

这是官方帮助文档给的代码

Sub Example_SetXdata()
    ' This example creates a line and attaches extended data to that line.
    
    ' Create the line
    Dim lineObj As AcadLine
    Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
    startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#
    endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
    ZoomAll

    ' Initialize all the xdata values. Note that first data in the list should be
    ' application name and first datatype code should be 1001
    Dim DataType(0 To 9) As Integer
    Dim Data(0 To 9) As Variant
    Dim reals3(0 To 2) As Double
    Dim worldPos(0 To 2) As Double
    
    DataType(0) = 1001: Data(0) = "Test_Application"
    DataType(1) = 1000: Data(1) = "This is a test for xdata"

    DataType(2) = 1003: Data(2) = "0"                   ' layer
    DataType(3) = 1040: Data(3) = 1.23479137438413E+40  ' real
    DataType(4) = 1041: Data(4) = 1237324938            ' distance
    DataType(5) = 1070: Data(5) = 32767                 ' 16 bit Integer
    DataType(6) = 1071: Data(6) = 32767                 ' 32 bit Integer
    DataType(7) = 1042: Data(7) = 10                    ' scaleFactor

    reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
    DataType(8) = 1010: Data(8) = reals3                ' real
    
    worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
    DataType(9) = 1011: Data(9) = worldPos              ' world space position
    
    ' Attach the xdata to the line
    lineObj.SetXData DataType, Data
    
    ' Return the xdata for the line
    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    lineObj.GetXData "", xtypeOut, xdataOut
    
End Sub

这是我自己写的钢筋外部信息扩展的代码

Sub 钢筋信息set(gjcs As String, plineobj As AcadLWPolyline, gjbh As String, jmlb As String)

    
    Dim Datatype(0 To 9) As Integer

    Dim Data(0 To 9) As Variant
'
    gjstrs = Split(gjcs, "XZ")
    gjstrs = Split(gjstrs(0), "@")
    gjzj = Split(gjstrs(0), Left(gjstrs(0), 5))
'
''    Datatype(0) = "直径": Datatype(1) = "单根长": Datatype(2) = "根数": Datatype(3) = "总长": Datatype(4) = "单位重": Datatype(5) = "总重"
''    Datatype(6) = "编号": Datatype(7) = "间距": Datatype(8) = "截面类别"
    
    Datatype(0) = 1001: Data(0) = "钢筋数据"
    Datatype(1) = 1000: Data(1) = gjstrs(0):
    Datatype(2) = 1000: Data(2) = CStr(plineobj.length):
    Datatype(3) = 1000: Data(3) = CStr(1000 / Val(gjstrs(1))):
    Datatype(4) = 1000: Data(4) = CStr(plineobj.length / Val(gjstrs(1)))
    Datatype(5) = 1000: Data(5) = CStr(Val(gjzj(1)) * Val(gjzj(1)) * 3.1415926 * 0.007844 / 4):
    Datatype(6) = 1000: Data(6) = CStr(Data(4) * Data(3)):
    Datatype(7) = 1000: Data(7) = gjbh:
    Datatype(8) = 1000: Data(8) = "@" & gjstrs(1)
    Datatype(9) = 1000: Data(9) = jmlb

    plineobj.SetXData Datatype, Data


End Sub