[求助]能否用EXCEL VBA向XRecord中写数据？
<p><font size="3">能否用EXCEL 中的VBA向Auto CAD中XRecord中写数据？</font></p><p><font size="3"> 在Auto CAD内部可以用VBA操作XRecord，不知道能否用EXCEL 中的VBA向Auto CAD中XRecord中写数据？</font></p><p><font size="3"> 还请高手赐教！</font></p><p>VBA操作XRECORD的示例代码:</p><p>Sub Example_AddXRecord()<br/> ' 该示例在扩展记录不存在时创建一个新的扩展记录，<br/> ' 并添加数据到该扩展记录中，然后将其读出。<br/> ' 要查看已经添加的数据，可再运行一次该示例。<br/> <br/> Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord<br/> Dim XRecordDataType As Variant, XRecordData As Variant<br/> Dim ArraySize As Long, iCount As Long<br/> Dim DataType As Integer, Data As String, msg As String<br/> <br/> ' 识别该扩展记录数据的唯一标识符<br/> Const TYPE_STRING = 1<br/> Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary"<br/> Const TAG_XRECORD_NAME = "ObjectTrackerXRecord"</p><p> ' 连接保存扩展记录的词典<br/> On Error GoTo CREATE<br/> Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)<br/> Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME)<br/> On Error GoTo 0<br/> <br/> ' 获取当前的扩展记录<br/> TrackingXRecord.GetXRecordData XRecordDataType, XRecordData<br/> <br/> ' 如果数组不存在则创建一个<br/> If VarType(XRecordDataType) And vbArray = vbArray Then<br/> ArraySize = UBound(XRecordDataType) + 1 ' 获取数据元素返回的大小<br/> ArraySize = ArraySize + 1 ' 增量保持新的数据<br/> <br/> ReDim Preserve XRecordDataType(0 To ArraySize)<br/> ReDim Preserve XRecordData(0 To ArraySize)<br/> Else<br/> ArraySize = 0<br/> ReDim XRecordDataType(0 To ArraySize) As Integer<br/> ReDim XRecordData(0 To ArraySize) As Variant<br/> End If<br/> <br/> ' 添加新的扩展记录数据<br/> '<br/> ' 在本例中只添加当前时间到扩展记录中<br/> XRecordDataType(ArraySize) = TYPE_STRING: XRecordData(ArraySize) = CStr(Now)<br/> TrackingXRecord.SetXRecordData XRecordDataType, XRecordData<br/> <br/> ' 读出所有的扩展记录数据条目<br/> TrackingXRecord.GetXRecordData XRecordDataType, XRecordData<br/> ArraySize = UBound(XRecordDataType)<br/> <br/> ' 找到并显示保存的扩展记录数据<br/> For iCount = 0 To ArraySize<br/> ' Get information for this element<br/> DataType = XRecordDataType(iCount)<br/> Data = XRecordData(iCount)<br/> <br/> If DataType = TYPE_STRING Then<br/> msg = msg & Data & vbCrLf<br/> End If<br/> Next<br/> <br/> MsgBox "在该扩展记录中的数据为: " & vbCrLf & vbCrLf & msg, vbInformation<br/> <br/> Exit Sub</p><p><br/>CREATE:<br/> ' 创建用于保持这些扩展记录数据的对象<br/> If TrackingDictionary Is Nothing Then ' 确认已经有跟踪对象<br/> Set TrackingDictionary = ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME)<br/> Set TrackingXRecord = TrackingDictionary.AddXRecord(TAG_XRECORD_NAME)<br/> End If<br/> <br/> Resume<br/>End Sub</p>
页:
[1]