13、扩展数据和扩展记录数据
可以将扩展数据（XData）和扩展记录数据（XRecordData）用作链接信息与图形中对象的方式。扩展数据和扩展记录数据的区别是：扩展数据有16K存储空间的限制，并且使用1000及以上的组码值，而扩展记录数据则没有空间和顺序的限制，并且组码在1000以下。还有一个不同之处是可以在选择集中操作扩展数据。ACAD提供了SetXData和GetXData的函数来设置和返回扩展数据，通常扩展数据需要提供一个已经注册的应用程序（RegisteredApplication）名称作为不同程序之间的数据区分。ACAD也提供了SetXRecordData和GetXRecordData的函数来设置和返回扩展记录数据，但是由于扩展记录数据是保存于扩展词典（ExtensionDictionary）中的，因而要用HasExtensionDictionary来判断是否包含扩展词典，而用GetExtensionDictionary来返回扩展词典，如不存在，它就会创建一个。再通过扩展词典的GetObject来返回扩展记录对象，AddXRecord添加一个扩展记录对象。
代码:
示例：
Sub Example_XData()
' 这个例子创建一条直线，并且添加扩展数据
' 创建直线
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)
' 初始化所有的扩展数据。注意第一个值必须是应用程序名称，而它的组码必须是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" ' 层
DataType(3) = 1040: Data(3) = 1.23479137438413E+40 ' 实数
DataType(4) = 1041: Data(4) = 1237324938 ' 距离
DataType(5) = 1070: Data(5) = 32767 ' 16位整数
DataType(6) = 1071: Data(6) = 32767 ' 32位整数
DataType(7) = 1042: Data(7) = 10 ' 比例因子
reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
DataType(8) = 1010: Data(8) = reals3 ' 实数
worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
DataType(9) = 1011: Data(9) = worldPos ' world space position
' 在直线上附着扩展数据
lineObj.SetXData DataType, Data
' 返回直线的扩展数据
Dim xdataOut As Variant
Dim xtypeOut As Variant
lineObj.GetXData "", xtypeOut, xdataOut
End Sub
示例：
Sub Example_XRecordData()
' 这个例子当扩展记录对象不存在时创建一个新的扩展记录对象，并且添加扩展记录数据。
Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord
Dim XRecordDataType As Variant, XRecordData As Variant
Dim ArraySize As Long, iCount As Long
Dim DataType As Integer, Data As String, msg As String
' Unique identifiers to distinguish our XRecordData from other XRecordData
Const TYPE_STRING = 1
Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary"
Const TAG_XRECORD_NAME = "ObjectTrackerXRecord"
' 连接扩展词典
On Error GoTo CREATE
Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)
Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME)
On Error GoTo 0
' 返回当前的扩展记录数据
TrackingXRecord.GetXRecordData XRecordDataType, XRecordData
' If we don't have an array already then create one
If VarType(XRecordDataType) And vbArray = vbArray Then
ArraySize = UBound(XRecordDataType) + 1 ' 返回扩展记录数据的元素个数
ArraySize = ArraySize + 1 ' Increase to hold new data
ReDim Preserve XRecordDataType(0 To ArraySize)
ReDim Preserve XRecordData(0 To ArraySize)
Else
ArraySize = 0
ReDim XRecordDataType(0 To ArraySize) As Integer
ReDim XRecordData(0 To ArraySize) As Variant
End If
' 添加新的扩展记录数据
' For this sample we only append the current time to the XRecord
XRecordDataType(ArraySize) = TYPE_STRING: XRecordData(ArraySize) = CStr(Now)
TrackingXRecord.SetXRecordData XRecordDataType, XRecordData
' Read back all XRecordData entries
TrackingXRecord.GetXRecordData XRecordDataType, XRecordData
ArraySize = UBound(XRecordDataType)
' Retrieve and display stored XRecordData
For iCount = 0 To ArraySize
' Get information for this element
DataType = XRecordDataType(iCount)
Data = XRecordData(iCount)
If DataType = TYPE_STRING Then
msg = msg & Data & vbCrLf
End If
Next
MsgBox "The data in the XRecord is: " & vbCrLf & vbCrLf & msg, vbInformation
Exit Sub
CREATE:
' Create the entities that hold our XRecordData
If TrackingDictionary Is Nothing Then ' Make sure we have our tracking object
Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME)
Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME)
End If
Resume
End Sub
以下是一些在开发人员手册中的关于扩展数据的示例。
代码:
将扩展数据指定给选择集中的所有对象
本例提示用户选择图形中的对象，然后将选定的对象置于选择集中，并且指定的扩展数据将附着到该选择集中的所有对象。
Sub Ch10_AttachXDataToSelectionSetObjects()
' 创建选择集
Dim sset As Object
Set sset = ThisDrawing.SelectionSets.Add("SS1")
' 提示用户选择对象
sset.SelectOnScreen
' 定义扩展数据
Dim appName As String, xdataStr As String
appName = "MY_APP"
xdataStr = "This is some xdata"
Dim xdataType(0 To 1) As Integer
Dim xdata(0 To 1) As Variant
' 为每个数组定义值
'1001 指示 appName
xdataType(0) = 1001
xdata(0) = appName
'1000 指示字符串值
xdataType(1) = 1000
xdata(1) = xdataStr
' 遍历选择集中的所有图元
' 将扩展数据设置和指定给每个图元
Dim ent As Object
For Each ent In sset
ent.SetXData xdataType, xdata
Next ent
End Sub
查看选择集中所有对象的扩展数据
本例显示上例所附着的扩展数据。如果附着的扩展数据不是字符串（类型 1000）类型，则需要修改此代码。
Sub Ch10_ViewXData()
' 查找上例中创建的选择集
Dim sset As Object
Set sset = ThisDrawing.SelectionSets.Item("SS1")
' 定义扩展数据变量以保存扩展数据信息
Dim xdataType As Variant
Dim xdata As Variant
Dim xd As Variant
'定义索引计数器
Dim xdi As Integer
xdi = 0
' 遍历选择集中的对象
' 并检索对象的扩展数据
Dim msgstr As String
Dim appName As String
Dim ent As AcadEntity
appName = "MY_APP"
For Each ent In sset
msgstr = ""
xdi = 0
' 检索 appName 扩展数据类型和值
ent.GetXData appName, xdataType, xdata
' 如果未初始化 xdataType 变量，
' 则没有可供该图元检索的 appName 扩展数据
If VarType(xdataType) <> vbEmpty Then
For Each xd In xdata
msgstr = msgstr & vbCrLf & xdataType(xdi) _
& ": " & xd
xdi = xdi + 1
Next xd
End If
' 如果 msgstr 变量为 NULL，则没有扩展数据
If msgstr = "" Then msgstr = vbCrLf & "NONE"
MsgBox appName & " xdata on " & ent.ObjectName & _
":" & vbCrLf & msgstr
Next ent
End Sub
选择包含扩展数据的圆
下例过滤包含由“MY_APP”应用程序添加的扩展数据的圆：
Sub Ch4_FilterXdata()
Dim sstext As AcadSelectionSet
Dim mode As Integer
Dim pointsArray(0 To 11) As Double
mode = acSelectionSetWindowPolygon
pointsArray(0) = -12#: pointsArray(1) = -7#: pointsArray(2) = 0
pointsArray(3) = -12#: pointsArray(4) = 10#: pointsArray(5) = 0
pointsArray(6) = 10#: pointsArray(7) = 10#: pointsArray(8) = 0
pointsArray(9) = 10#: pointsArray(10) = -7#: pointsArray(11) = 0
Dim FilterType(1) As Integer
Dim FilterData(1) As Variant
Set sstext = ThisDrawing.SelectionSets.Add("SS9")
FilterType(0) = 0
FilterData(0) = "Circle"
FilterType(1) = 1001
FilterData(1) = "MY_APP"
sstext.SelectByPolygon mode, pointsArray, FilterType, FilterData
End Sub |
|小黑屋|手机版|模具论坛
( 浙ICP备15037217号 )
发表于 2009-6-6 09:50:37
楼主
/5 
