一点字典帮助 - 请
在VBA，我真的很努力地去理解这本字典，但是我仍然有困难。我用下面的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
**** Hidden Message ***** 今天真的很忙，所以我需要停止在这里查看，但是哦，好吧。我没有时间给你一个好答案，所以我给你两个坏答案
从帮助
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：我发布这个，因为它似乎有点像你需要的
我发现的一个想法是，如果将xrecord视为字典，则它将出错，因此注意vardic是一个对象
我想我是在搞乱这个子，想弄清楚如何从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
谢谢你们的帮助
以下是我的结论：
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
我在表单刷新代码中包含了字典内容，因为我不知道如何在函数之间传递变量
jb 这里有一件非常简单的事情，希望能把它弄清楚
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]