一个小字典帮助-请
本人'；我真的很想在VBA中了解字典的内容，但我&35;039；我仍然有麻烦 ；本人'；我用以下LISP在namedobjdict中创建了一个xrecord:(defun jb:SaveKeynoteFilename(file / datalist xname newdict)(setq dataList (append (list '(0 . "XRECORD") '(100 . "AcDbXrecord") (cons 300 file)))
xname (entmakex dataList))
(dictremove (namedobjdict) "JB_KEYNOTE_FILE")
(setq newdict
(dictadd (namedobjdict) "JB_KEYNOTE_FILE" xname)
xname nil)
newdict)
有谁能告诉我如何通过VBA检索这些数据吗 ；非常感谢
jb
今天真的很忙，所以我需要退出这里的检查，但哦，好吧 ；唐#039；我没有时间给你一个好答案，所以我35;039；我给你两个坏的
来自帮助Sub Example_GetXData()
' This example creates a line and attaches extended data to that line.
' Create the line
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)
ZoomAll
' Initialize all the xdata values. Note that first data in the list should be
' application name and first datatype code should be 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" ' layer
DataType(3) = 1040: Data(3) = 1.23479137438413E+40' real
DataType(4) = 1041: Data(4) = 1237324938 ' distance
DataType(5) = 1070: Data(5) = 32767 ' 16 bit Integer
DataType(6) = 1071: Data(6) = 32767 ' 32 bit Integer
DataType(7) = 1042: Data(7) = 10 ' scaleFactor
reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
DataType(8) = 1010: Data(8) = reals3 ' real
worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
DataType(9) = 1011: Data(9) = worldPos ' world space position
' Attach the xdata to the line
lineObj.SetXData DataType, Data
' Return the xdata for the line
Dim xdataOut As Variant
Dim xtypeOut As Variant
lineObj.GetXData "", xtypeOut, xdataOut
End Sub 你可以用同样的方法来做，下面的内容几乎没有经过深思熟虑，也完全没有经过测试，几乎可以保证不起作用，但应该会让你走上正确的道路Sub test()
Dim objDic As AcadDictionary
Dim objDix As AcadDictionaries
Dim varXDO As Variant
Dim varXTO As Variant
Set objDix = ThisDrawing.Dictionaries
For Each objDic In objDix
If objDic.Name = "JB_KEYNOTE_FILE" Then
objDic.GetXData "", varXDO, varXTO
Exit For
End If
Next objDic
End Sub jb I'；我张贴这个，因为它似乎有点像你需要的
我发现的一个想法是，如果你把xrecord当作字典来对待，那么它就会出错，所以注意vardic是一个对象
我想我是在搞乱这个sub，想知道如何从vba中获得一些lisp。分担痛苦
Sub Dimstuff()
'(dictremove (namedobjdict) "AcadDim")
'(setq cur (append '((0 . "XRECORD") (100 . "AcDbXrecord") (90 . 990106)) cur))
'(dictadd (namedobjdict) "AcadDim" (entmakex cur))
'(acet-ql-get)
Dim varDic As AcadObject
Dim oDic As AcadDictionary
Dim oDics As AcadDictionaries
Dim x As AcadXRecord
Dim i As Integer
Dim XRecordDataType As Variant, XRecordData As Variant
Dim ArraySize As Long, iCount As Long
Dim DataType As Integer, Data As String, msg As String
Dim isThere As Boolean
Set oDics = ThisDrawing.Dictionaries
For Each varDic In oDics
If TypeOf varDic Is AcadXRecord Then
Debug.Print "XRecord=" & varDic.Name
If varDic.Name = "AcadDim" Then
Set x = varDic
isThere = True
Exit For
End If
End If
If TypeOf varDic Is AcadDictionary Then
Debug.Print "Dictionary=" & varDic.Name
If varDic.Name = "AcadDim" Then
Set oDic = varDic
For Each x In oDic
Debug.Print x.Name
Next
'Set X = oDic.GetObject("AcadDim")
'IsThere = True
Exit For
End If
End If
Next
If Not isThere Then
Debug.Print isThere
Dim xType(16) As Integer, XData(16)
xType(0) = 90: XData(0) = 990106
xType(1) = 3: XData(1) = ""
xType(2) = 40: XData(2) = 0
xType(3) = 60: XData(3) = 0
xType(4) = 61: XData(4) = 0
xType(5) = 62: XData(5) = 2
xType(6) = 63: XData(6) = 2
xType(7) = 64: XData(7) = 0
xType(8) = 65: XData(8) = 0
xType(9) = 66: XData(9) = 0
xType(10) = 67: XData(10) = 3
xType(11) = 68: XData(11) = 0
xType(12) = 69: XData(12) = 0
xType(13) = 70: XData(13) = 0
xType(14) = 71: XData(14) = 1
xType(15) = 72: XData(15) = 0
xType(16) = 170: XData(16) = 0
Set oDic = oDics.Add("AcadDim")
Set x = oDic.AddXRecord("AcadDim")
x.SetXRecordData xType, XData
End If
For Each varDic In oDics
'Debug.Print varDic.ObjectName
If TypeOf varDic Is AcadDictionary Then
Debug.Print varDic.Name
End If
If TypeOf varDic Is AcadXRecord Then
Debug.Print "XRecord=" & varDic.Name
End If
Next
On Error Resume Next
x.GetXRecordData XRecordDataType, XRecordData
For i = 0 To UBound(XRecordDataType)
' Get information for this element
DataType = XRecordDataType(i)
Data = XRecordData(i)
Debug.Print i, DataType, Data
Next
End Sub 谢谢你们的帮助
Argh-我仍然不'；我不喜欢VBA中的字典 ；It#039；在LISP中是如此简单
此处'；这就是我的结局：
Public Sub jbKeyNotesFormRefresh()
Dim KeynoteDict As AcadDictionary, KeynoteXRecord 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
Dim file As String, str As String
' Unique identifiers to distinguish this XRecordData from other XRecordData
Const TYPE_STRING = 300
Const TAG_DICTIONARY_NAME = "JB_KEYNOTE"
Const TAG_XRECORD_NAME = "JB_KEYNOTE_FILE"
' Connect to the dictionary in which to store the XRecord
On Error GoTo ERR
Set KeynoteDict = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME)
Set KeynoteXRecord = KeynoteDict.GetObject(TAG_XRECORD_NAME)
On Error GoTo 0
' Get current XRecordData
KeynoteXRecord.GetXRecordData XRecordDataType, XRecordData
' If there is no array yet then create one
If VarType(XRecordDataType) And vbArray = vbArray Then
ArraySize = UBound(XRecordDataType) + 1 ' Get the size of the data elements returned
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
' Read back all XRecordData entries
KeynoteXRecord.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
file = Data
End If
Next
KeyNotes.ListBox2.Clear
On Error GoTo ErrMessage
If Not file = "" Then
Open file For Input As #1
Do While Not EOF(1)
Input #1, str
KeyNotes.ListBox2.AddItem (str)
Loop
Close #1
End If
ErrMessage:
Close #1
Exit Sub
Exit Sub
ERR:
KeyNotes.ListBox2.Clear
End Sub 我在表单刷新代码中包含了字典内容，因为我可以'；t找出如何在函数之间传递变量
jb 这里是#039；这是一件非常简单的事情，希望能解决它public sub test()
Dim strOne as String
dim StrTwo as string
dim intOne as integer
dim intTwo as integer
strone = "This"
strtwo = "a (hopefully simple to"
intone = 3
inttwo = 1
msgbox stringmaker(strone,strtwo,intone,inttwo)
end sub
Public Function StringMaker(strA as string, strB as string, intA as integer, intB as integer) as string
stringmaker = strA & " is " & strB & " understand) demonstration on passing data to and from a function as easy as " & intb & ", 2, " & inta
end function
页:
[1]