扩展字典问题
Sub mysel()Dim sset As AcadSelectionSet '定义选择集对象
Dim element As AcadEntity '定义选择集中的元素对象
Dim objdic As AcadDictionary
Dim objrec As AcadXRecord
Dim jim As String
Dim xdtype(10) As Variant
Dim xdt(10) As Variant
Set sset = ThisDrawing.SelectionSets.Add("ca0s") '新建一个选择集
sset.SelectOnScreen '提示用户选择
Set element = sset.Item(0)
UserForm1.Show
Dim i As Integer
For i = 0 To 5
xdtype(i) = i + 10
xdt(i) = UserForm1.Controls("TextBox" & (i + 1)).Value
Next
Set objdic = element.GetExtensionDictionary()
Set objrec = objdic.AddXRecord(jim)
objrec.SetXRecordData xdtype, xdt
End Sub
运行到objrec.SetXRecordData xdtype, xdt这句时就出错,[调用方法setobjectid(接口iacadbaseobject)失败],我想是不是xdatatype有类型的要求,但是我看网上别的例子都可以用的啊,书上也说只要1000以下都可以的.哪位大侠帮忙看一下,谢谢
参考如下代码：
'——————————————————————————————————————————————————
'名称：XRecord_ForJIM
'作者：罗简单
'日期：2008-11-5
'功能：为选择的实体添加扩展字典，并且添加完成后，读出
'扩展字典内的值(为乐筑天下中jimzhoujim书写的代码)
'——————————————————————————————————————————————————
Sub XRecord_ForJIM()
Dim pEnt As AcadEntity'定义实体
Dim pBasePt As Variant'定义获取实体的点
ThisDrawing.Utility.GetEntity pEnt, pBasePt, vbNewLine & "请需要添加扩展字典的选择实体："
Dim pDictionary As AcadDictionary
Dim pXRecord As AcadXRecord
Dim pType(2) As Integer
Dim pData(2) As Variant
'设置自定义值
pType(0) = 1: pData(0) = "jimzhoujim" '作者
pType(1) = 2: pData(1) = Now '日期
pType(2) = 2: pData(2) = "XRecord_Test" '名称
Dim pKeyWord As String
pKeyWord = "jim"
'******************************************************
'获取刚才选择的实体pEnt的扩展字典(Extension Dictionary)
'If an object does not have an extension dictionary,
'this method will create a new extension dictionary
'for that object and return it in the return value.
'You can query an object to see if it has an extension
'dictionary by using the HasExtensionDictionary property.
Set pDictionary = pEnt.GetExtensionDictionary
Set pXRecord = pDictionary.AddXRecord(pKeyWord)
'******************************************************
'添加扩展字典
pXRecord.SetXRecordData pType, pData
'获取刚才添加的扩展字典
pXRecord.GetXRecordData pType, pData
Dim i As Integer'循环参数
Dim strMessage As String
For i = 0 To UBound(pType)
strMessage = strMessage & vbCrLf & pType(i) & "：" & pData(i)
Next i
'以消息框的形式呈现给JIM
MsgBox strMessage
End Sub
你的代码经过如下修改可用
Sub mysel()
Dim sset As AcadSelectionSet '定义选择集对象
Dim element As AcadEntity '定义选择集中的元素对象
Dim objdic As AcadDictionary
Dim objrec As AcadXRecord
Dim jim As String
Dim xdtype(10) As Integer '这里修改为Integer
Dim xdt(10) As Variant
Set sset = ThisDrawing.SelectionSets.Add("ca1110s") '新建一个选择集
sset.SelectOnScreen '提示用户选择
Set element = sset.Item(0)
Dim i As Integer
For i = 0 To 5 '好像这里不能大于10，这个得再研究研究，如果你研究出来了请与我分享一下（QQ：45096732）
xdtype(i) = i
xdt(i) = Str(i)
Next
Set objdic = element.GetExtensionDictionary()
jim = "jim" '这里需要先初始化
Set objrec = objdic.AddXRecord(jim)
objrec.SetXRecordData xdtype, xdt
objrec.GetXRecordData xdtype, xdt
'因为在上面数组的上限设的是10，所以
'后面的4个值是NULL
For i = 0 To UBound(xdtype)
MsgBox xdt(i)
Next i
End Sub
XRecord 对象用来存储和管理任意数据。该对象概念上与 XData 相似但不限制长度和顺序。
与 XData 不同的是，XRecords 的值使用所有低于 1000 的标准 AutoCAD 组码。它支持所有标准的 AutoCAD 组码。也就是说，除了所有正常使用的数据类型，XRecord 还能够存储对象 ID，这使 XRecords 可以拥有其它对象包括其它的 XRecords。
以下组码对所有 XRecord 对象通用: 组码
描述
100子类标记 (AcDbXrecord) 1-369 (除了 5 和 105) 这些值可以由程序以任何方式使用。
页:
[1]