TheSwamp

Code Red => VB(A) => Topic started by: T.Willey on July 18, 2006, 01:24:20 PM

Title: Getting Xrecord Data (lesson 2)
Post by: T.Willey on July 18, 2006, 01:24:20 PM
Here is my code
Code: [Select]
Public Function GetXRecLisp() As AcadXRecord

Dim DictCol As AcadDictionaries
Dim MyDict As AcadDictionary
Dim XRec As AcadXRecord

Set DictCol = ThisDrawing.Dictionaries
On Error GoTo MyError
Set MyDict = DictCol.Item("LisptoVBA")
Set XRec = MyDict.Item("LisptoVBA")
Set GetXRecLisp = XRec

Exit Function

MyError:
    MsgBox "Error " & Err.Number & " ( " & Err.Description & " )"
   

End Function

Public Sub ShowXrecData(ByRef XRec As AcadXRecord)

Dim DataType As Integer
Dim Data As Variant
Dim Cnt As Integer

Set XRec = GetXRecLisp
XRec.GetXRecordData DataType, Data
For Cnt = 0 To UBound(Data)
    MsgBox Data(Cnt)
Next

End Sub

It seems like the first one works.  I tried it with two drawings, one with information, no error message prompt, one with no information, and got the error message.  My problem seems to be with the second code.  I'm trying to see if I can get the xrecord data without specifying a size, and just print it to a message box (command line would be fine also, for now).

Thanks in advance for any help.

Here is the lisp code used to add the xrecord, and dictionary (just incase).
Code: [Select]
(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
; See help for types and numbers to use.

(vla-SetXRecordData Obj
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbInteger
    (cons 0 (1- (length CodeList)))
   )
   CodeList
  )
 )
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbVariant
    (cons 0 (1- (length Datalist)))
   )
   DataList
  )
 )
)
)

(MySetXrec
 (vla-AddXRecord
  (vla-Add
   (vla-get-Dictionaries
    (vla-get-ActiveDocument
     (vlax-get-Acad-Object)
    )
   )
   "LisptoVBA"
  )
  "LisptoVBA"
 )
 '(1 2)
 '("Testing" "Again")
)
Title: Re: Getting Xrecord Data (lesson 2)
Post by: MP on July 18, 2006, 01:37:24 PM
Untested <conceptual coding> but this is how I might code GetXRecLisp for flexibility --

Code: [Select]
Public Function GetXRecLisp(dictname As String, _
                            xrecname As String) _
                            As AcadXRecord

    Dim dict As AcadDictionary, _
        xrec As AcadXRecord
   
    On Error GoTo GetXRecLispError
    Set dict = ThisDrawing.Dictionaries.Item(dictname)
    Set xrec = dict.Item(xrecname)
    Set GetXRecLisp = xrec
    Exit Function
   
GetXRecLispError:

    Err.Clear
    Set GetXRecLisp = Nothing
    ''  caller tests for nothing result

End Function

Also note var / label naming (case / specificity etc).

Retentively yours,

MP

:)
Title: Re: Getting Xrecord Data (lesson 2)
Post by: T.Willey on July 18, 2006, 01:46:43 PM
Thanks Michael.  I will look at coding for more flexibility when I understand what I'm doing. :wink:  I like what you show though, as always.

What do you mean by
Also note var / label naming (case / specificity etc).
Should var's all be lower case?  Is this something that VBA likes?
Title: Re: Getting Xrecord Data (lesson 2)
Post by: MP on July 18, 2006, 01:51:39 PM
I try / tend to code --

subs / functions: Capital case, then camel case, e.g. GetSomeValue
local variables: lower case, then camel case, e.g. dictMain
module / (class) member variables: prefixed with my, then same as subs, e.g. myCollection
widgets: prefixed with abbrev. of widget type, then as subs, e.g. frmMain.

Big topic, but sorry, gotta go to a lunch meeting, bye!
Title: Re: Getting Xrecord Data (lesson 2)
Post by: Jeff_M on July 18, 2006, 02:08:08 PM
Tim, I more or less follow what MP describes, but I think it is more a personal taste for what looks good to you.

As for your error, I think that it stems from Dim'ing the DataType as Integer in the GetXrecordData code......when you are GETTING something Acad returns a Variant, I know it's bassackwards from when you are Putting something, but it's what they decided to use. So try changing the Integer to Variant and I think it will work....... in fact here's what I used to test your  SetXrecord code:
Code: [Select]
Public Sub getXRec(ByRef XrecName As String)

Dim DictCol As AcadDictionaries
Dim MyDict As AcadDictionary
Dim Xrec As AcadXRecord
Dim DataType As Variant
Dim Data As Variant
Dim I As Integer

Set DictCol = ThisDrawing.Dictionaries
Set MyDict = DictCol.Add("VBAtoLisp")
Set Xrec = MyDict.Item(XrecName)
Xrec.GetXRecordData DataType, Data
For I = 0 To UBound(Data)
    Debug.Print DataType(I) & " - " & Data(I)
Next

End Sub
Title: Re: Getting Xrecord Data (lesson 2)
Post by: T.Willey on July 18, 2006, 02:24:01 PM
Code: [Select]
Public Sub ShowXrecData(ByRef Xrec As AcadXRecord)

Dim DataType As Variant
Dim Data As Variant
Dim Cnt As Integer

Set Xrec = GetXRecLisp
Xrec.GetXRecordData DataType, Data
For Cnt = 0 To UBound(Data)
    Debug.Print Data(Cnt)
Next

End Sub

So I changed my code to look like above.  How can I get it to run so that I can test it?  I hit the play button, but it is asking for a macro name.  It seems it is because it is defined with an argument.  When I tried to put it into a sub with no arguments, and call it, it didn't work.

Thanks Jeff.
Title: Re: Getting Xrecord Data (lesson 2)
Post by: Bob Wahr on July 18, 2006, 02:31:55 PM
You need to pass an xrecord to this sub when you call it.  The other option would be to get rid of "ByRef Xrec As AcadXRecord" and Dim it in this sub.  If you go that way you will have to hunt through the dictionaries collection for the dictionary, then through the dictionary to find the xrecord.
Title: Re: Getting Xrecord Data (lesson 2)
Post by: Jeff_M on July 18, 2006, 02:33:35 PM
What Bob said, but since you are getting it in the code you don't need to pass it as an argument. This is carrying on from your other thread's code:
Code: [Select]
Public Function GetXRecLisp() As AcadXRecord

Dim DictCol As AcadDictionaries
Dim MyDict As AcadDictionary
Dim XRec As AcadXRecord

Set DictCol = ThisDrawing.Dictionaries
On Error GoTo MyError
Set MyDict = DictCol.Item("VBAtoLisp")
Set XRec = MyDict.Item("VBAtoLisp")
Set GetXRecLisp = XRec

Exit Function

MyError:
    MsgBox "Error " & Err.Number & " ( " & Err.Description & " )"
   

End Function

Public Sub ShowXrecData()

Dim DataType As Variant
Dim Data As Variant
Dim Cnt As Integer
Dim XRec As AcadXRecord

Set XRec = GetXRecLisp
XRec.GetXRecordData DataType, Data
For Cnt = 0 To UBound(Data)
    MsgBox Data(Cnt)
Next

End Sub

Sub test2()
ShowXrecData
End Sub
Title: Re: Getting Xrecord Data (lesson 2)
Post by: T.Willey on July 18, 2006, 02:39:58 PM
Thank you, all three.  It is working now.  Don't know what I put that there.  Must have tried to code to early in the work day morning.
Title: Re: Getting Xrecord Data (lesson 2)
Post by: T.Willey on July 18, 2006, 04:05:27 PM
    ''  caller tests for nothing result
You don't know how long it took me to finally find out how to do this.  Searching here, and the help files, but I have it now so it's all good.  Time for lunch.