一点字典帮助 - 请

(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)

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

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

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