[求助]：能否给一个块存储一个数据表的xdata例程

lyq511

表的形式如(2 2a)(3 5)(4 7)..... 等

efan2000

在所有的实体中都可以存放XDATA数据，看看下面的例子吧，具体怎么存放，那要看你自己怎么控制了。

2. 
   
3.   [FONT=courier new]
   
4. Sub Example_SetXdata()
   
5.     ' This example creates a line and attaches extended data to that line.
   
6.    
   
7.     ' Create the line
   
8.     Dim lineObj As AcadLine
   
9.     Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
   
10.     startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#
    
11.     endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
    
12.     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
    
13. 
    
14.     ZoomAll
    
15. 
    
16.     ' Initialize all the xdata values. Note that first data in the list should be
    
17.     ' application name and first datatype code should be 1001
    
18.     Dim DataType(0 To 9) As Integer
    
19.     Dim Data(0 To 9) As Variant
    
20.     Dim reals3(0 To 2) As Double
    
21.     Dim worldPos(0 To 2) As Double
    
22.    
    
23.     DataType(0) = 1001: Data(0) = "Test_Application"
    
24. 
    
25.     DataType(1) = 1000: Data(1) = "This is a test for xdata"
    
26. 
    
27.     DataType(2) = 1003: Data(2) = "0"                   ' layer
    
28.     DataType(3) = 1040: Data(3) = 1.23479137438413E+40  ' real
    
29.     DataType(4) = 1041: Data(4) = 1237324938            ' distance
    
30.     DataType(5) = 1070: Data(5) = 32767                 ' 16 bit Integer
    
31.     DataType(6) = 1071: Data(6) = 32767                 ' 32 bit Integer
    
32. 
    
33.     DataType(7) = 1042: Data(7) = 10                    ' scaleFactor
    
34. 
    
35.     reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
    
36.     DataType(8) = 1010: Data(8) = reals3                ' real
    
37.    
    
38.     worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
    
39.     DataType(9) = 1011: Data(9) = worldPos              ' world space position
    
40. 
    
41.    
    
42.     ' Attach the xdata to the line
    
43.     lineObj.SetXData DataType, Data
    
44.    
    
45.     ' Return the xdata for the line
    
46.     Dim xdataOut As Variant
    
47.     Dim xtypeOut As Variant
    
48.     lineObj.GetXData "", xtypeOut, xdataOut
    
49.    
    
50. End Sub
    
51.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Example_SetXdata()<br />     ' This example creates a line and attaches extended data to that line.<br />     <br />     ' Create the line<br />     Dim lineObj As AcadLine<br />     Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double<br />     startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#<br />     endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#<br />     Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)<br /> <br />     ZoomAll<br /> <br />     ' Initialize all the xdata values. Note that first data in the list should be<br />     ' application name and first datatype code should be 1001<br />     Dim DataType(0 To 9) As Integer<br />     Dim Data(0 To 9) As Variant<br />     Dim reals3(0 To 2) As Double<br />     Dim worldPos(0 To 2) As Double<br />     <br />     DataType(0) = 1001: Data(0) = "Test_Application"<br /> <br />     DataType(1) = 1000: Data(1) = "This is a test for xdata"<br /> <br />     DataType(2) = 1003: Data(2) = "0"                   ' layer<br />     DataType(3) = 1040: Data(3) = 1.23479137438413E+40  ' real<br />     DataType(4) = 1041: Data(4) = 1237324938            ' distance<br />     DataType(5) = 1070: Data(5) = 32767                 ' 16 bit Integer<br />     DataType(6) = 1071: Data(6) = 32767                 ' 32 bit Integer<br /> <br />     DataType(7) = 1042: Data(7) = 10                    ' scaleFactor<br /> <br />     reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20<br />     DataType(8) = 1010: Data(8) = reals3                ' real<br />     <br />     worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989<br />     DataType(9) = 1011: Data(9) = worldPos              ' world space position<br /> <br />     <br />     ' Attach the xdata to the line<br />     lineObj.SetXData DataType, Data<br />     <br />     ' Return the xdata for the line<br />     Dim xdataOut As Variant<br />     Dim xtypeOut As Variant<br />     lineObj.GetXData "", xtypeOut, xdataOut<br />     <br /> End Sub<br />   [/FONT]<br />