[求助]集合类是否可以设置扩展数据

maobamboo

对象都都可以设置扩展数据和获取其扩展数据

看见ACAD的帮助文档 集合类也可以设置扩展数据和获取扩展数据

代码如下：

Sub Example_GetXData()
    ' This example creates a line and attaches extended data to that line.
   
    ' Create the line
    Dim lineObj As AcadLine
    Dim layersobject As AcadLayers
    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
  Set layersobject = ThisDrawing.Layers
   layersobject.SetXData DataType, Data

    ' Return the xdata for the line
    Dim xdataOut As Variant
    Dim xtypeOut As Variant
  layersobject.GetXData "", xtypeOut, xdataOut
 
End Sub
运行程序报错，想问下SetXData GetXData 不支持集合类？

雪山飞狐_lzh

这种情况用字典更好

lihengmin

  Set layersobject = ThisDrawing.Layers
   layersobject.SetXData DataType, Data

扩展数据只能赋给实体，不能赋给层吧！