Topic: a little dictionary help - please

[jbuzbee]

I've really tried to get my head around this dictionary stuff in VBA but I'm still having trouble.  I've created an xrecord in the namedobjdict with the following LISP:

Code: [Select]

(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)
Can anyone give me a start on how to retrieve this data via VBA?  Thanks a bunch!

jb

[Bob Wahr]

REALLY busy today, enough so that I need to quit checking here but oh well.  Don't have time to give you a good answer so I'll give you two bad ones.

From help

Code: [Select]

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
You would do it the same way the following is barely thought through and entirely untested, just about guaranteed to not work, but should get you going down the right road

Code: [Select]

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

[Bryco]

jb I'm posting this as it seems to be a little like you need.
The think i found was that an xrecord will error if you treat it like a dictionary so note vardic is an object.
I think I was messing with this sub to try figure how to get at some lisp from vba. Share the pain.

Code: [Select]

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

[jbuzbee]

Thanks for the help guys!

Argh - I still don't like dictionaries in VBA!  It's so simple in LISP!!!

Here's what I ended up with:

Code: [Select]

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

I included the dictionary stuff in the Form Refresh code because I can't figure out how to pass variables between functions??

jb

[Bob Wahr]

Here's a really simple thing that will hopefully clear it up

Code: [Select]

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