Topic: getxrecord method problems

[Peter Jamtgaard]

Hi Swamp,

I have been playing with VBA (shutter...) which is not my area of expertise to try and answer a question from a gentleman in France who is trying to store and retrieve information in dictionaries.

Below is my attempt to get and retrieve the data.

The problem I am having is with the getxrecord method

Code: [Select]


objXRecordReturn.GetXRecordData XRecordDataTypeReturn, XRecordDataReturn


It doesn't seem to be retrieving the datatype or data and returning blanks.

I ave checked using lisp and the data is there.

Do any of you have some modules for this? Or do you know why I am not getting the correct data?

Peter Jamtgaard

Code: [Select]


Option Explicit
Public Sub Test()
    Dim arrMyData(3) As Variant
    arrMyData(0) = "hello"
    arrMyData(1) = "There"
    arrMyData(2) = "jean"
    CreateDictionary "test7"
    CreateXRecords "test7", arrMyData
    ReadXRecords "test7"
End Sub
Private Sub CreateDictionary(strDictionaryName As String)
    Dim objDictionary As AcadDictionary
    On Error Resume Next
    Set objDictionary = ThisDrawing.Dictionaries.Add(strDictionaryName)
    objDictionary.Delete
    Set objDictionary = ThisDrawing.Dictionaries.Add(strDictionaryName)
End Sub
Private Sub CreateXRecords(strDictionaryName As String, arrMyData() As Variant)
    Dim intIndex As Integer
    Dim objDictionary As AcadDictionary
    Dim objXRecord As AcadXRecord
    Dim XRecordData(0) As Variant
    Dim XRecordDataType(0) As Integer
    Set objDictionary = ThisDrawing.Dictionaries.Item(strDictionaryName)
    MsgBox "Storing XRecord Information: "
    For intIndex = 0 To UBound(arrMyData) - 1
        Set objXRecord = objDictionary.AddXRecord(CStr(intIndex) & "A")
        XRecordDataType(0) = 1
        XRecordData(0) = arrMyData(intIndex)
        objXRecord.SetXRecordData XRecordDataType, XRecordData
    Next intIndex
End Sub
Private Sub ReadXRecords(strDictionaryName As String)
    MsgBox "Retieving XRecord Information: "
    Dim intIndex As Integer
    Dim arrMyDataReturn(3) As Variant
    Dim objDictionary As AcadDictionary
    Dim objXRecordReturn As AcadXRecord
    Dim XRecordDataReturn(0) As Variant
    Dim XRecordDataTypeReturn(0) As Integer
    Set objDictionary = ThisDrawing.Dictionaries.Item(strDictionaryName)
    For intIndex = 0 To objDictionary.Count - 1
        Set objXRecordReturn = objDictionary.Item(CStr(intIndex) & "A")
        MsgBox objDictionary.Name & " Item: " & objXRecordReturn.Name
        objXRecordReturn.GetXRecordData XRecordDataTypeReturn, XRecordDataReturn
        MsgBox "XRecordDataTypeReturn: " & XRecordDataTypeReturn(0)
        arrMyDataReturn(intIndex) = XRecordDataReturn(0)
        MsgBox "XRecordDataReturn: " & XRecordDataReturn(0)
    Next intIndex
    MsgBox arrMyDataReturn(0) & " " & arrMyDataReturn(1) & " " & arrMyDataReturn(2)
End Sub


[Rob_Kish]

Hi Peter ...
Seems the only critical problem (meaning one denying completion ... without an Error) lies with the dimension of the 'carriers'.

In ReadXRecords, both receivers must be pure variants (must not be dimensioned as arrays; they must be flexible). Remove the (0) from both and your code runs fine.

< edit to add >

Code: [Select]

' use this instead
    Dim XRecordDataReturn As Variant
    Dim XRecordDataTypeReturn As Variant
    ...
< /end clarification>