[下载]：如何使用扩展记录？看看我的

urgod

扩展记录的使用，说到底就是如何管理其中的链表。
我这里做了一个类用于实现对扩展记录的管理。
该类封装了扩展记录的链表，使得扩展记录可以根据tag方便的读取、更改、添加、删除 。
不必考虑链表中各项的顺序，只需知道各个tag即可。
可以实现嵌套存储。

该类的使用必须结合arx目录下samples－－》arxdbg 中的例子
这个例子是非常非常不错的，我的这个类就是参考里面的扩展数据类而写的，大家可以看看

efan2000

我见过这种的操作方法，一般是采用相同的组码，值采用字符串的形式，就如“Tag=Value”，操作时，只要知道Tag，程序根据设定的组码，取出Value的值。不知你采用的是不是这种方法。

urgod

是的，不过我这里的tag是int型

XDSoft

扩展数据可以保存ACAD的大多数据类型：

表、字符串、整数、实数、句柄、点对...

都有组码和他们对应。

efan2000

但是有时候保存一些信息用这种方法还是最好的，
如：SetXData(EntObj,AppName,Tag,Value)就可以保存了，
GetXData(EntObj,AppName,Tag)就可以读取了。比每次自己去分析强多了。以下是我编程中用到的两个函数。

2. 
   
3.   [FONT=courier new]
   
4. '获取扩展数据
   
5. Public Function GetXDataText(ByVal EntObj As AcadObject, ByVal Name As String, ByVal Tag As String) As String
   
6.     Dim xdType As Variant
   
7.     Dim xdData As Variant
   
8.     Dim i As Integer
   
9.     Dim temp As Variant
   
10.    
    
11.     On Error GoTo ErrTrap
    
12.     If EntObj Is Nothing Then Exit Function
    
13.     If Name = "" Or Tag = "" Then Exit Function
    
14.     GetXDataText = ""
    
15.     EntObj.GetXData Name, xdType, xdData
    
16.     If Not IsEmpty(xdType) Then
    
17.         For i = LBound(xdType) To UBound(xdType)
    
18.             If xdData(i) <> "" Then
    
19.                 temp = Split(xdData(i), "=", , vbTextCompare)
    
20.                 If Not IsEmpty(temp) Then
    
21.                     If StrComp(temp(0), Tag, vbTextCompare) = 0 Then
    
22.                         If UBound(temp) >= 1 Then GetXDataText = temp(1)
    
23.                         Exit For
    
24.                     End If
    
25.                 End If
    
26.                 temp = Empty
    
27.             End If
    
28.         Next
    
29.     End If
    
30.     xdType = Empty
    
31.     xdData = Empty
    
32.     Exit Function
    
33.    
    
34. ErrTrap:
    
35.     Debug.Print "GetXDataText: " & Err.Number & ", " & Err.Description
    
36.     On Error GoTo 0
    
37. End Function
    
38. 
    
39. '设置扩展数据
    
40. Public Sub SetXDataText(ByRef EntObj As AcadObject, ByVal Name As String, ByVal Tag As String, ByVal Text As String)
    
41.     Dim xdType As Variant
    
42.     Dim xdData As Variant
    
43.     Dim i As Integer
    
44.     Dim temp As Variant
    
45.     Dim bExist As Boolean
    
46. 
    
47.     On Error GoTo ErrTrap
    
48.     If EntObj Is Nothing Then Exit Sub
    
49.     If Name = "" Or Tag = "" Then Exit Sub
    
50.     EntObj.GetXData Name, xdType, xdData
    
51.     If Not IsEmpty(xdType) Then
    
52.         For i = LBound(xdType) To UBound(xdType)
    
53.             If xdData(i) <> "" Then
    
54.                 temp = Split(xdData(i), "=", , vbTextCompare)
    
55.                 If Not IsEmpty(temp) Then
    
56.                     If StrComp(temp(0), Tag, vbTextCompare) = 0 Then
    
57.                         bExist = True
    
58.                         xdData(i) = Tag & "=" & Text
    
59.                         EntObj.SetXData xdType, xdData
    
60.                         Exit For
    
61.                     End If
    
62.                 End If
    
63.                 temp = Empty
    
64.             End If
    
65.         Next
    
66.         If bExist = False Then
    
67.             temp = UBound(xdType) + 1
    
68.             ReDim Preserve xdType(0 To temp)
    
69.             ReDim Preserve xdData(0 To temp)
    
70.             xdType(temp) = 1000
    
71.             xdData(temp) = Tag & "=" & Text
    
72.             EntObj.SetXData xdType, xdData
    
73.             temp = Empty
    
74.         End If
    
75.     Else
    
76.         ReDim xdType(0 To 1) As Integer
    
77.         ReDim xdData(0 To 1) As Variant
    
78.         xdType(0) = 1001
    
79.         xdData(0) = Name
    
80.         xdType(1) = 1000
    
81.         xdData(1) = Tag & "=" & Text
    
82.         EntObj.SetXData xdType, xdData
    
83.     End If
    
84.     xdType = Empty
    
85.     xdData = Empty
    
86.     Exit Sub
    
87.    
    
88. ErrTrap:
    
89.     Debug.Print "SetXDataText: " & Err.Number & ", " & Err.Description
    
90.     On Error GoTo 0
    
91. End Sub
    
92.   [/FONT]
    

<br />   [FONT=courier new]<br /> '获取扩展数据<br /> Public Function GetXDataText(ByVal EntObj As AcadObject, ByVal Name As String, ByVal Tag As String) As String<br />     Dim xdType As Variant<br />     Dim xdData As Variant<br />     Dim i As Integer<br />     Dim temp As Variant<br />     <br />     On Error GoTo ErrTrap<br />     If EntObj Is Nothing Then Exit Function<br />     If Name = "" Or Tag = "" Then Exit Function<br />     GetXDataText = ""<br />     EntObj.GetXData Name, xdType, xdData<br />     If Not IsEmpty(xdType) Then<br />         For i = LBound(xdType) To UBound(xdType)<br />             If xdData(i) <> "" Then<br />                 temp = Split(xdData(i), "=", , vbTextCompare)<br />                 If Not IsEmpty(temp) Then<br />                     If StrComp(temp(0), Tag, vbTextCompare) = 0 Then<br />                         If UBound(temp) >= 1 Then GetXDataText = temp(1)<br />                         Exit For<br />                     End If<br />                 End If<br />                 temp = Empty<br />             End If<br />         Next<br />     End If<br />     xdType = Empty<br />     xdData = Empty<br />     Exit Function<br />     <br /> ErrTrap:<br />     Debug.Print "GetXDataText: " & Err.Number & ", " & Err.Description<br />     On Error GoTo 0<br /> End Function<br /> <br /> '设置扩展数据<br /> Public Sub SetXDataText(ByRef EntObj As AcadObject, ByVal Name As String, ByVal Tag As String, ByVal Text As String)<br />     Dim xdType As Variant<br />     Dim xdData As Variant<br />     Dim i As Integer<br />     Dim temp As Variant<br />     Dim bExist As Boolean<br /> <br />     On Error GoTo ErrTrap<br />     If EntObj Is Nothing Then Exit Sub<br />     If Name = "" Or Tag = "" Then Exit Sub<br />     EntObj.GetXData Name, xdType, xdData<br />     If Not IsEmpty(xdType) Then<br />         For i = LBound(xdType) To UBound(xdType)<br />             If xdData(i) <> "" Then<br />                 temp = Split(xdData(i), "=", , vbTextCompare)<br />                 If Not IsEmpty(temp) Then<br />                     If StrComp(temp(0), Tag, vbTextCompare) = 0 Then<br />                         bExist = True<br />                         xdData(i) = Tag & "=" & Text<br />                         EntObj.SetXData xdType, xdData<br />                         Exit For<br />                     End If<br />                 End If<br />                 temp = Empty<br />             End If<br />         Next<br />         If bExist = False Then<br />             temp = UBound(xdType) + 1<br />             ReDim Preserve xdType(0 To temp)<br />             ReDim Preserve xdData(0 To temp)<br />             xdType(temp) = 1000<br />             xdData(temp) = Tag & "=" & Text<br />             EntObj.SetXData xdType, xdData<br />             temp = Empty<br />         End If<br />     Else<br />         ReDim xdType(0 To 1) As Integer<br />         ReDim xdData(0 To 1) As Variant<br />         xdType(0) = 1001<br />         xdData(0) = Name<br />         xdType(1) = 1000<br />         xdData(1) = Tag & "=" & Text<br />         EntObj.SetXData xdType, xdData<br />     End If<br />     xdType = Empty<br />     xdData = Empty<br />     Exit Sub<br />     <br /> ErrTrap:<br />     Debug.Print "SetXDataText: " & Err.Number & ", " & Err.Description<br />     On Error GoTo 0<br /> End Sub<br />   [/FONT]<br />

urgod

to XDsoft:
扩展数据里面保存句柄恐怕不太好吧，
我一般是在扩展记录里保存另外一个实体的ID,通过kDxfSoftPoint

XDSoft

最初由 urgod 发布
[B]to XDsoft:
扩展数据里面保存句柄恐怕不太好吧，
我一般是在扩展记录里保存另外一个实体的ID,通过kDxfSoftPoint [/B]

上面只是说扩展数据可以保存句柄，并没有说是否好和坏，看大家习惯了。

保存句柄也很用用和方便，在晓东工具箱里面的“弧长标注”、“弧标三合一”转换工具，就用到了这个，把弧线的句柄保存到“弧线标注”实体的扩展数据里面。可以智能识别标注对应的是哪个弧线实体进行查询。

DARCY

我下载了一个却解不开？
见图：

urgod

还有下载了解不开的么？
我是用winrar3压缩的，你看看你的winrar版本对不对

noname

我觉得分标签和值两项来保存是比较好的一种做法，而且，都用字符串类型，比较统一；