问xdata的问题

bluefires

我希望可以给轻量多义线赋予一些属性，我就想用SetXData和GetXData的方法，可是我看了一下组码datatype，不知道是不是可以随便使用的。我要做的东西只是要赋予一些属性再读出来而已，大家帮我讲讲XData的用途，以及我这样做可不可以

雪山飞狐_lzh

VBA的例子里就有

[WEB]http://www.mccad.net/object/acad2004/ex_setxdata.htm[/WEB]

sangding

方法可行

bluefires

lzh，你给的那个文档我都看过了，我试验了一下子，发现发现必须严格按照DataType的值去赋予Data数据，我现在想给一条多义线赋予四个值，四个值都是字符串，不是很长。请问具体怎么做。麻烦先回答这个问题，然后再问下我用字典做怎么样？

bluefires

DataType(2) = 1003: Data(2) = "0" 

例如这条语句，当你的图中没有“0”这个层时就会出现数据不符合的问题。我当时看了DFX的码值，我用了一些它里面说可以用于字符的，可以试验不成功，可能是我没看懂文档，我现在把所有关于Xdata的文档都看了还是不是很明白使用这个的时候有什么具体的限制。不过在这个的过程中我发现了字典这个东西，getXrecord 这个东西，我目前还没好好研究，只是看了文档的例子，要大家有事件的话给我一些实际的指导或者源代码。等过段时间我的项目做完了我把我的代码传上了给大家点评一下。

雪山飞狐_lzh

    Dim xt(4) As Integer,xd(4)

    xt(0) = 1001: xd(0) = "testapp"
    xt(1) = 1000: xd(1) = "a"
    xt(2) = 1000: xd(2) = "b"
    xt(3) = 1000: xd(3) = "c"
    xt(4) = 1000: xd(4) = "d"

bluefires

    Dim xt(4) As Integer,xd(4)

    xt(0) = 1001: xd(0) = "testapp"
    xt(1) = 1000: xd(1) = "a"
    xt(2) = 1000: xd(2) = "b"
    xt(3) = 1000: xd(3) = "c"
    xt(4) = 1000: xd(4) = "d"
这个我试了下不行啊，我是在Autocad2006试得，lzh741206你试试看呢？

 

雪山飞狐_lzh

没有问题的，我从2002到2007都做过的：）

看看你的测试代码？

bluefires

就拿你前面给我的代码做个测试，我测试的时候他告诉我类型不对，郁闷！你看看行不行，该不会是版本的问题。

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

    Dim DataType(0 To 4) As Integer
    Dim Data(0 To 4) As Variant

   
    DataType(0) = 1001: Data(0) = "testapp"
    DataType(1) = 1000: Data(1) = "a"
    DataType(2) = 1000: Data(2) = "b"                  
    DataType(3) = 1000: Data(3) = "c"
    DataType(4) = 1000: Data(4) = "d"         
  
   
    ' 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

sangding

你在程序第一行加上    On Error Resume Next
 

试试

我发现有时程序不好用的时候加上这个就好用了