扩展字典问题

jimzhoujim 发表于 2008-11-6 14:27:00

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以下都可以的.哪位大侠帮忙看一下,谢谢

robbin840311 发表于 2008-11-6 16:29:00

参考如下代码：'—————————————————————————————————————————————————— '名称：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 strMessageEnd Sub

robbin840311 发表于 2008-11-6 16:34:00

本帖最后由作者于 2008-11-6 16:36:05 编辑 你的代码经过如下修改可用Sub mysel() Dim sset As AcadSelectionSet '定义选择集对象 Dim element As AcadEntity '定义选择集中的元素对象 Dim objdic As AcadDictionary Dim objrec As AcadXRecord Dim jim As StringDim 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, xdtobjrec.GetXRecordData xdtype, xdt '因为在上面数组的上限设的是10，所以 '后面的4个值是NULL For i = 0 To UBound(xdtype)   MsgBox xdt(i) Next i End SubXRecord 对象用来存储和管理任意数据。该对象概念上与 XData 相似但不限制长度和顺序。 与 XData 不同的是，XRecords 的值使用所有低于 1000 的标准 AutoCAD 组码。它支持所有标准的 AutoCAD 组码。也就是说，除了所有正常使用的数据类型，XRecord 还能够存储对象 ID，这使 XRecords 可以拥有其它对象包括其它的 XRecords。 以下组码对所有 XRecord 对象通用: <table cellspacing="1" cellpadding="4" border="0"><tbody><tr valign="top"><th align="left">组码</th><th align="left">描述</th></tr><tr valign="top"><td class="body">100 </td><td class="body"> 子类标记 (AcDbXrecord) </td></tr><tr valign="top"><td class="body">1-369 (除了 5 和 105) </td><td class="body">这些值可以由程序以任何方式使用。</td></tr></tbody></table>

页: [1]

明经CAD社区's Archiver

扩展字典问题