Topic: XData question

[T.Willey]

I'm trying to learn more about XData.  So I was thinking I would write a little routine that did a polyline, then then associated xdata to it.  Could be cool to associate room information to a room to generate a schedule.  I can't seem to get it right.  Can anyone help me with this.  It seems to put the xdata there, but I can't retrive it after.  The error I get is

; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

when running "MyGetXData".  Here is the code so far (still working on it).

Code: [Select]

(defun c:RoomInfo (/ ActDoc StPt Pt PtList CoordList PolyObj CodeList DataList CodeNum)

;---------------------------------------------------------------------------
(defun MySetXData (Obj CodeList DataList / )
; Sets XData to an object.  Must number in code list must be 1001

(vla-SetXData 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
  )
 )
)
)
;-----------------------------------------------------------------------------
(defun MyGetXData (Obj DataName / CodeType DataType)
; Retrive XData for an object

(vla-GetXData
 Obj
 (if DataName
  DataName
  ""
 )
 'CodeType
 'DataType
)
(if (and CodeType DataType)
 (mapcar
  '(lambda (a b)
   (cons a (variant-value b))
  )
  (safearray-value CodeType)
  (safearray-value DataType)
 )
)
)
;---------------------------------------------------------------------------------

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(while
 (if StPt
  (setq Pt (getpoint StPt "\n Select next point: "))
  (setq Pt (getpoint "\n Select first point of polygon: "))
 )
 (if (not StPt)
  (setq StPt Pt)
 )
 (setq PtList (cons Pt PtList))
 (if (> (length PtList) 1)
  (grdraw (cadr PtList) (car PtList) 1)
 )
)
(grdraw (car PtList) StPt 1)
(foreach Pt PtList
 (setq CoordList (cons (cadr Pt) CoordList))
 (setq CoordList (cons (car Pt) CoordList))
)
(setq PolyObj
 (vlax-invoke
  (vlax-get
   ActDoc
   (if (equal (getvar "cvport") 1)
    'PaperSpace
    'ModelSpace
   )
  )
  'AddLightweightPolyline
  CoordList
 )
)
(vla-put-Closed PolyObj :vlax-true)
(setq CodeList '(1001))
(setq DataList '("MyRoomInformation"))
(setq CodeNum 1000)
(foreach Question '("Room name: " "Room number: ")
 (if (/= (setq tmpStr (getstring T (strcat "\n " Question))) "")
  (setq
   CodeList (cons CodeNum CodeList)
   DataList (cons tmpStr DataList)
   CodeNum
    (if (equal CodeNum 1000)
     (+ 2 CodeNum)
     (1+ CodeNum)
    )
  )
 )
)
(setq CodeList (cons 1040 CodeList))
(setq DataList (cons (vlax-get PolyObj 'Area) DataList))
(MySetXData PolyObj (reverse CodeList) (reverse DataList))
(MyGetXData PolyObj nil)
(princ)
)
If you comment out the line "(MyGetXData PolyObj nil)" then it won't error, but I can't retrive the xdata information.

Thanks in advance.

[LE]

Tim;

This is not a direct answer and coming from someone that have use this two functions just once... I will simple post how I have done it, hope that would help.

Code: [Select]

(defun vlax-make-array-type  (lst atype)
  (vlax-safearray-fill
    (vlax-make-safearray
      atype
      (cons 0 (1- (length lst))))
    lst))

(defun fractional-dim  (obj str)
  (vla-setxdata
    obj
    ;; XDataType as Variant (array of short)
    (vlax-make-array-type
      (list 1001 1000 1002 1070 1000 1070 1070 1002)
      vlax-vbinteger)
    ;; XData as Array of Variant
    (vlax-make-array-type
      (list
(vlax-make-variant "ACAD" vlax-vbstring)
(vlax-make-variant "DSTYLE" vlax-vbstring)
(vlax-make-variant "{" vlax-vbstring)
(vlax-make-variant 3 vlax-vbinteger)
(vlax-make-variant str vlax-vbstring)
(vlax-make-variant 277 vlax-vbinteger)
(vlax-make-variant 5 vlax-vbinteger)
(vlax-make-variant "}" vlax-vbstring))
      vlax-vbvariant)))

And I think to get the values, something like:

Code: [Select]

(vla-GetXData obj "myAPPNAME" 'XDataType 'XDataValue)

Then just explore the values of those two new variables....

If is a 'safearray' use (setq XDataType (vlax-safearray->list XDataType)) for both vars

Then, in your mapcar check if it is a variant and safearray and do the conversion the first with vlax-variant-value and the other using vlax-safearray->list and place them into your resultant list

Hope that the above makes some sense...

[LE]

BTW,

There is one function to get xdata... in the www.acadx.com site

HTH

[T.Willey]

Luis,

First off, Thanks for posting.

Yours does work, and I can get the xdata with my function after.  Do you remember why you set it up that way?  Is it required by AutoCAD?  I have looked through the help files, and have not had success with finding what I'm looking for, which is mostly my fault, as I don't know exactly what that may be.

My code seems to work if you only enter one bit of information, but if you enter information for both prompts, then it won't attach any xdata to the object.

BTW,

There is one function to get xdata... in the www.acadx.com site

HTH

I just looked at their code, and it is close to what I have already, and it seems mine works okay because it returned the xdata that your routine attached.  Thanks for the link though.

I will continue to try and see what I'm doing wrong.  I hope I don't have to set it up the way you did.  I'm hoping that it can be a little more flexible.

[Jeff_M]

Tim, a part of the problem in yours is this:

Code: [Select]

(setq
   CodeList (cons CodeNum CodeList)
   DataList (cons tmpStr DataList)
   CodeNum
    (if (equal CodeNum 1000)
     (+ 2 CodeNum)
     (1+ CodeNum)
    )
  )
This sets CodeNum to 1002 which is the code for a Control String. From the help: "An extended data control string can be either “{”or “}”. " Keep the CodeNum at 1000 for strings.

FWIW, your code runs without error in 2006, but only the first 2 items in the list get written:
((1001 . "MyRoomInformation") (1000 . "master"))

[T.Willey]

This sets CodeNum to 1002 which is the code for a Control String. From the help: "An extended data control string can be either “{”or “}”. " Keep the CodeNum at 1000 for strings.

FWIW, your code runs without error in 2006, but only the first 2 items in the list get written:
((1001 . "MyRoomInformation") (1000 . "master"))

Thanks Jeff.  I thought that might be the problem, but I tried setting the codes 1001 1000 1002 and then having the first prompt put in the information at 1003, but that didn't work either.  I was going off this from the help.

1000–1009
 String (same limits as indicated with 0–9 code range)
 
1010–1059
 Double-precision floating-point value
 
1060–1070
 16-bit integer value
 
1071
 32-bit integer value
 

And then I saw this, so I changed it a little, still with no luck.

1000
 ASCII string (up to 255 bytes long) in extended data
 
1001
 Registered application name (ASCII string up to 31 bytes long) for extended data
 
1002
 Extended data control string ("{" or "}")
 
1003
 Extended data layer name
 
1004
 Chunk of bytes (up to 127 bytes long) in extended data
 
1005
 Entity handle in extended data; text string of up to 16 hexadecimal digits

Are there different numbers I can use? or do I have to just use 1000 for all my strings?  I was hoping that each entry could have it's own number, so that way I would know what each one was.

Thanks again Jeff and Luis.

[Jeff_M]

Are there different numbers I can use? or do I have to just use 1000 for all my strings?  I was hoping that each entry could have it's own number, so that way I would know what each one was.

Thanks again Jeff and Luis.

AFAIK you must use 1000 for all normal strings.  However, to be able to determine what is what, use multiple 1000 codes....for instance:

Code: [Select]

(setq roomnum "23"
      roomname "MasterBedroom"
      sqft 240.00)

(setq roomlist (list '(1000 . "RoomNumber")
     (cons 1000 roomnum)
     '(1000 . "RoomName")
     (cons 1000 roomname)
     '(1000 . "SquareFeet")
     (cons 1040 sqft)
     )
      )
(cdadr (member '(1000 . "RoomName") roomlist))
will return this:
"MasterBedroom"
 

[T.Willey]

AFAIK you must use 1000 for all normal strings. However, to be able to determine what is what, use multiple 1000 codes....for instance:

If that is the only way, then this is the code I will be using, for now at least.  Thanks again.

Code: [Select]

(defun c:RoomInfo (/ ActDoc StPt Pt PtList CoordList PolyObj CodeList DataList CodeNum)
; Attach information to a poly that is drawn within the routine.
; v0.01

;---------------------------------------------------------------------------
(defun MySetXData (Obj CodeList DataList / )
; Sets XData to an object.  Must number in code list must be 1001

(vla-SetXData 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
  )
 )
)
)
;-----------------------------------------------------------------------------
(defun MyGetXData (Obj DataName / CodeType DataType)
; Retrive XData for an object

(vla-GetXData
 Obj
 (if DataName
  DataName
  ""
 )
 'CodeType
 'DataType
)
(if (and CodeType DataType)
 (mapcar
  '(lambda (a b)
   (cons a (variant-value b))
  )
  (safearray-value CodeType)
  (safearray-value DataType)
 )
)
)
;---------------------------------------------------------------------------------

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(while
 (if StPt
  (setq Pt (getpoint StPt "\n Select next point: "))
  (setq Pt (getpoint "\n Select first point of polygon: "))
 )
 (if (not StPt)
  (setq StPt Pt)
 )
 (setq PtList (cons Pt PtList))
 (if (> (length PtList) 1)
  (grdraw (cadr PtList) (car PtList) 1)
 )
)
(grdraw (car PtList) StPt 1)
(foreach Pt PtList
 (setq CoordList (cons (cadr Pt) CoordList))
 (setq CoordList (cons (car Pt) CoordList))
)
(setq PolyObj
 (vlax-invoke
  (vlax-get
   ActDoc
   (if (equal (getvar "cvport") 1)
    'PaperSpace
    'ModelSpace
   )
  )
  'AddLightweightPolyline
  CoordList
 )
)
(vla-put-Closed PolyObj :vlax-true)
(setq CodeList '(1001))
(setq DataList '("MyRoomInformation"))
(setq CodeNum 1000)
(foreach Question '("ROOM NAME" "ROOM NUMBER")
 (if (/= (setq tmpStr (getstring T (strcat "\n " Question ": "))) "")
  (setq
   CodeList (cons CodeNum CodeList)
   CodeList (cons CodeNum CodeList)
   DataList (cons Question DataList)
   DataList (cons tmpStr DataList)
  )
 )
)
(setq CodeList (cons 1000 CodeList))
(setq CodeList (cons 1040 CodeList))
(setq DataList (cons "AREA" DataList))
(setq DataList (cons (vlax-get PolyObj 'Area) DataList))
(MySetXData PolyObj (reverse CodeList) (reverse DataList))
;(print (MyGetXData PolyObj nil)) ; To make sure it got put there.
(princ)
)


[Peter Jamtgaard]

I created a couple functions for using xdata, and the easiest way I could think of was to use an xdata to list and list to xdata schema, I also included my standard errortrap function see below.

(setxdata obj (list (list "App1" 1 "Hello")(list "App2" "World" 2)))

would create the App1 and App2 registered applications and store the other items as xdata on the object.

Then

(getxdata obj) would return

'(("App1" 1 "Hello")(list "App2" "World" 2)))

much the same way ldata works

Peter

Code: [Select]

; The setxdata function will add a list of sublists to an object as xdata.
; The first item in each sublist is a unique string application name
(defun SetXData (objSelection lstOfSubLists / DataItem lstData
                 intDataType lstOfSublistsDXFCodes lstOfSublistsValues
                 safDXFCodes safDataValues)               
 (if debug (princ "\nSetXdata: "))
 (if (= (type objSelection) 'ENAME)
  (setq objSelection (vlax-ename->vla-object objSelection))
 )
 (foreach lstData lstOfSublists
  (setq lstOfSublistsDXFCodes (cons 1001 lstOfSublistsDXFCodes)
        lstOfSublistsValues   (cons (car lstData) lstOfSublistsValues))
  (RegApp (car lstData))
  (foreach DataItem (cdr lstData)
   (cond    ; Determine the data type and corrusponding DXF Code
    ((= (type DataItem) 'INT)
     (if (> DataItem 100000)
      (setq intDataType  1071)                          ; Long    Data Type
      (setq intDataType  1070)                          ; Integer Data Type
     )
    )                                                   
    ((= (type DataItem) 'REAL)(setq intDataType  1040)) ; Real Data Type
    ((= (type DataItem) 'STR)
     (if (or (= DataItem "{")(= DataItem "}"))          ; String Data Type     
      (setq intDataType  1002)
      (setq intDataType  1000)
     )
    )
   )
   (setq lstOfSublistsDXFCodes (cons intDataType lstOfSublistsDXFCodes)
         lstOfSublistsValues   (cons DataItem    lstOfSublistsValues)
   )
  )
 )
 (setq safDXFCodes   (listToSafearray vlax-vbinteger
                      (reverse lstOfSublistsDXFCodes))                     
       safDataValues (listToSafeArray vlax-vbvariant
                      (reverse lstOfSublistsValues)))
 (errortrap '(vla-setXData objSelection safDXFCodes safDataValues)))

; Returns a list of sublists that include a application name as the first
; Item in every sublist and data for the remaining members

(defun C:GetXdata ()
 (getxdata (car (entsel "\nSelect object with Xdata: ")))
)

(defun GetXdata (objSelection / intCount lstAll lstSub safDXFValues safDXFValues)
;  (print strXdata)  (if DEBUG (print "GetXdata"))
 (if (= (type objSelection) 'ENAME)
  (setq objSelection (vlax-ename->vla-object objSelection))
 )
 (vla-getxdata objSelection "" 'safDXFCodes 'safDXFValues)
 (if (and safDXFCodes
          safDXFValues
     )
  (progn
   (setq lstDXFCodes  (vlax-safearray->list safDXFCodes) 
         lstDXFValues (mapcar 'variant-value (vlax-safearray->list safDXFValues)) 
         intCount 0
   )
   (foreach intDXFCode lstDXFCodes
    (if (= intDXFCode 1001)
     (if lstSub
      (setq lstAll (cons (reverse lstSub) lstAll)
            lstSub (list (nth intCount lstDXFValues))
      )
      (setq lstSub (list (nth intCount lstDXFValues))) 
     )
     (setq lstSub (cons (nth intCount lstDXFValues) lstSub))   
    )
    (setq intCount (1+ intCount))
   )
   (if lstSub (reverse (cons (reverse lstSub) lstAll)))
  )
 )
)

; Standardized Error Trap
(defun ErrorTrap (symFunction / objError result)
 (if (vl-catch-all-error-p
      (setq objError (vl-catch-all-apply
                     '(lambda (X)(set X (eval symFunction)))
                      (list 'result))))
  (progn
   (if DEBUG
    (progn
     (princ "\n")
     (princ (vl-catch-all-error-message objError))
     (princ "\nWhile evaluating the expression: ")
     (princ symfunction)
     (princ "\n")
    )
   )
   nil 
  )
  (if result result 'T)
 )
)




[GDF]

Tim

Here is two routines I found for getting the xdata:

Code: [Select]

(defun C:XDL1 (/ BMENT BMSEL ELST FOROBJ)
 (vl-load-com)
 (setq BMSEL (entsel "\n* Select Object to Get It's Xdata *"))
 (if BMSEL
  (progn
   (setq BMENT (car BMSEL))
   (vlax-for FOROBJ (vla-get-registeredapplications
                     (vla-get-database
                      (vla-get-activedocument
                       (vlax-get-acad-object)
                      )
                     )
                    )
    (setq ELST (entget BMENT (list (vla-get-name FOROBJ))))
    (if (assoc -3 ELST)
     (print (cadr (assoc -3 ELST)))  (print (cadar (assoc -3 ELST)))
    )
   )
  )
 )   
 (prin1)
)

(defun C:XDL2 (/ ENAM EOBJ XDTYPE XDVALUE)
  (setq ENAM (car (entsel "\n* Select Object to Get It's Xdata *"))
EOBJ (vlax-ename->vla-object ENAM)
  )
  (vla-getXData EOBJ "MyRoomInformation" 'XDTYPE 'XDVALUE)
  (setq xd
  (mapcar
    '(lambda (X Y)
       (cons X (variant-value Y))
     )
    (vlax-safearray->list XDTYPE)
    (vlax-safearray->list XDVALUE)
  ))
  (princ)
)

The author is Peter Jamtgaard (I think)

Question, now how do you break apart the dotted par to read like:

Room Name  Living
Room Nunber 123
Area 211

Gary

[Jürg Menzi]

(...) I thought that might be the problem, but I tried setting the codes 1001 1000 1002 and then having the first prompt put in the information at 1003, but that didn't work either. (...)

Tim, there are some restrictions with the field codes 1003 (LayerNames) and 1005 (Handles). It's not possible to add other data than (existing) LayerNames / Handles to this fields.

[T.Willey]

Thanks everyone.  It seems like the consensus is that you only use one number per type of entry with xdata.  I can work with this.

[Peter Jamtgaard]

One thing to remember about xdata is you cant get rid of it if you attach it to an object.

Ldata on the other hand can be deleted.

Have you ever investigate ldata?

If you are not using vba or other languages for getting the information out of the drawing you may find it easier and sometimes more versitile.

Oh and those two functions were some of my old stuff Gary, anyone is welcome to use them of course.

Peter

[Chuck Gabriel]

One thing to remember about xdata is you cant get rid of it if you attach it to an object.

Can't you get rid of it by overwriting the data with a null list.  I'm sure I've done this in VBA.

[T.Willey]

One thing to remember about xdata is you cant get rid of it if you attach it to an object.

Ldata on the other hand can be deleted.

Have you ever investigate ldata?
Peter

I haven't really, but I have read discussions that said ldata wasn't that good by some pretty smart programmers.  If I can find the again I will post links to those conversations.

Is ldata better to use than xdata?  Opinions welcomed.

[LE]

I haven't really, but I have read discussions that said ldata wasn't that good by some pretty smart programmers.  If I can find the again I will post links to those conversations.

Is ldata better to use than xdata?  Opinions welcomed.

Not being pretty smart .... I would simple say yes....   

And would then.... think... hmm why not then use xrecords, dictionaries? 

[Chuck Gabriel]

Sorry to post this in a LISP forum, but I don't have the mental energy to translate it from VBA right now.  This is how you erase xdata.

Code: [Select]

Sub ClearXdata(obj As acadobject, appName As String)
  Dim dataType(0) As Integer
  Dim dataValue(0) As Variant
  dataType(0) = 1001: dataValue(0) = appName
  obj.setXdata dataType, dataValue
End Sub


[Jeff_M]

Can't you get rid of it by overwriting the data with a null list. I'm sure I've done this in VBA.

Yep, there are numerous posts on how to do this on the Adesk customization group....which Peter used to frequent, so I'm shocked he's unaware of this.

[Kerry]

One thing to remember about xdata is you cant get rid of it if you attach it to an object.
............................
Peter

This clears XDAta .. Unless I mis-understand ...

Code: [Select]

(defun StripXdata (ename appname / )
  (entmod (list (cons -1 ename) (list -3 (list appname))))
)

[Kerry]

Here's the output ..

XDLIST
Select object:
Enter application name <*>:

* Registered Application Name: KBUB
* Code 1002, Starting or ending brace: {
* Code 1000, ASCII string: apples
* Code 1002, Starting or ending brace: }

Object has 16368 bytes of Xdata space available.


Command: (stripXdata (car (entsel)) "KBUB")

Select object: ((-1 . <Entity name: 7ef61fa8>) (-3 ("KBUB")))

Command: XDLIST

Select object:
Enter application name <*>:

No Xdata associated with Application Name(s).

Object has 16383 bytes of Xdata space available.

[Jeff_M]

I haven't really, but I have read discussions that said ldata wasn't that good by some pretty smart programmers. If I can find the again I will post links to those conversations.

Is ldata better to use than xdata? Opinions welcomed.

I've read these same discussions and based on them decided long ago to steer clear of ldata. I will, however, say that lately I've been using Extension Dictionaries more.

[T.Willey]

I was going to try and understand dictionaries once, but then I didn't have a use for them at the time.  What I'm doing here is storing information about a polyline object, I didn't see any way to attach an xrecord to it, only xdata, so I went that way.  I guess I could use a dictionary to store the ename (handle), and then just grab from there.

Which is better than, xdata or xrecords and dictionaries?  Since it seems like ldata is out.

Thanks for the interesting conversation, I'm learning a lot.

[CAB]

Tim have you looked at these?
http://www.theswamp.org/forum/index.php?topic=4395.msg53028#msg53028

http://www.theswamp.org/forum/index.php?topic=1283.msg16322#msg16322

http://www.theswamp.org/forum/index.php?topic=103.msg857#msg857

http://www.theswamp.org/forum/index.php?topic=1375.0

http://www.theswamp.org/forum/index.php?topic=2646.msg33944#msg33944

[Jeff_M]

I was going to try and understand dictionaries once, but then I didn't have a use for them at the time. 
Thanks for the interesting conversation, I'm learning a lot.

Tim, here are some helper functions and test code to show how Dictionaries attached to objects work. Note that they are similar to Xdata, but they don't require a registered application. I don't show that each object can have multiple xrecords in it's dictionary and even the xrecords can have their own dictionaries! (Not sure how or where this would be needed, but it's fun to know it can be done.... )

Code: [Select]

;| Functions and associated test command, to show their usage,
   for using and working with Extension Dictionaries
   by Jeff Mishler Feb. 7, 2006 |;
(defun get-or-add-xrecord (obj key / oDict tmp)
  (setq oDict (vla-getextensiondictionary obj))
  (setq tmp (vl-catch-all-apply
      '(lambda ()
(vla-item oDict key)
)))
  (if (vl-catch-all-error-p tmp)
    (setq tmp (vla-addxrecord odict key))
    )
  tmp
  )
;;;;;;;;
(defun getxrecorddata (oDict key / return xrec xval)
  (setq xrec (vl-catch-all-apply '(lambda ()
    (vla-item odict key))))
  (if (not (vl-catch-all-error-p xrec))
    (progn
      (vla-getxrecorddata xrec 'xData 'xVal)
      (setq return (mapcar '(lambda (a b)
      (cons a (vlax-variant-value b))
      )
   (vlax-safearray->list xData)
   (vlax-safearray->list xVal)
   )
    )
      )
    )
  return
  )
;;;;;;;;;
(defun putxrecorddata (xrec pairs / iCodes vData)
  (mapcar '(lambda (x)
     (setq iCodes (cons (car x) iCodes)
   vData (cons (vlax-make-variant (cdr x) vlax-vbvariant) vData))
     )
  pairs
  )
  (setq iCodes (vlax-safearray-fill
(vlax-make-safearray vlax-vbinteger (cons 0 (1- (length iCodes))))
iCodes))
  (setq vData (vlax-safearray-fill
(vlax-make-safearray vlax-vbvariant (cons 0 (1- (length vData))))
vData))
  (vla-setxrecorddata xrec iCodes vData)
  )
;;;;;;;;
(defun vl-sel (/ ent)
  (if (setq ent (car (entsel "\nSelect object: ")))
    (vlax-ename->vla-object ent)
    )
  )
;;;;;;;;
(defun c:test (/ ent xrec)
  ;| the pairs may be in any order, the code value can be anything from
     1-369 EXCEPT 5, 100 or 105, and the normal type matching must be
     followed...see the DXF reference for the code/type matchups. |;
  (setq lst '((1 . "TEST1")(40 . 700.00)(60 . 75)))
  (setq ent (vl-sel))
  (setq xrec (get-or-add-xrecord ent "MyTest2"))
  (putxrecorddata xrec lst)
  (setq newpairs (getxrecorddata
   (vla-getextensiondictionary ent)
   "MyTest2"
   )
)
  (print newpairs)
  (princ)
  )


[Kerry]

One feature of XData worth considering is the dynamic characteristics of some of the Fields

From Organization of Extended Data in the Developers Guide ..

World Space Position

1011. Unlike a simple 3D point, the WCS coordinates are moved, scaled, rotated, and mirrored along with the parent entity to which the extended data belongs. The WCS position is also stretched when the STRETCH command is applied to the parent entity and when this point lies within the select window.

World Space -Displacement

1012. A 3D point that is scaled, rotated, or mirrored along with the parent, but not stretched or moved.

World -Direction

1013. A 3D point that is rotated or mirrored along with the parent, but not scaled, stretched, or moved. The WCS direction is a normalized displacement that always has a unit length.

Distance

1041. A real value that is scaled along with the parent entity.

Scale Factor

1042. Also a real value that is scaled along with the parent.

[MickD]

I have been meaning to see if those values work for xrecords also but I don't think so. The reason I know they work for xdata is every AcDbEntity has an XdataTransformBy() function that is called when you modify an object. Whether this includes xrecords I'm not sure?

[T.Willey]

Tim have you looked at these?

Nope.  I got a lot of reading to do.  Thanks Alan.

Tim, here are some helper functions and test code to show how Dictionaries attached to objects work. Note that they are similar to Xdata, but they don't require a registered application. I don't show that each object can have multiple xrecords in it's dictionary and even the xrecords can have their own dictionaries! (Not sure how or where this would be needed, but it's fun to know it can be done.... )

Thanks Jeff.  I will look this over, and hopefully understand it when I have some time.  Real work awaits me today.

One feature of XData worth considering is the dynamic characteristics of some of the Fields

From Organization of Extended Data in the Developers Guide ..

Thanks Kerry for this.  I don't know enough yet to work with these, but hopefully soon I will.

I have been meaning to see if those values work for xrecords also but I don't think so. The reason I know they work for xdata is every AcDbEntity has an XdataTransformBy() function that is called when you modify an object. Whether this includes xrecords I'm not sure?

Thanks for the info Mick, that is nice to know.

[T.Willey]

So I went the dictionary route.  I think that I will like that one better.  I can have more control over the codes entered, and that will make it easier to make a function when I extract the information out of the dictionary.  Thanks for all the help, and useful opinions.  Here is the code as is.  It worked in my testing, any comments/suggestions welcomed.

Code: [Select]

(defun c:RoomInfov02 (/ ActDoc Sel StPt EntData PolyObj Dict Xrec CodeList DataList tmpStr CoordList PtList Pt
                        ExInfo tmpExInfo XrecList)

;---------------------------------------------------------------------------
(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData.  Must be between 1-369, except for 5, 100, 105.
; See help for information on 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
  )
 )
)
)
;-----------------------------------------------------------------------------
(defun MyGetXRec (Obj / CodeType DataType)
; Retrive XRecordData for an object

(vla-GetXRecordData
 Obj
 'CodeType
 'DataType
)
(if (and CodeType DataType)
 (mapcar
  '(lambda (a b)
   (cons a (variant-value b))
  )
  (safearray-value CodeType)
  (safearray-value DataType)
 )
)
)
;-----------------------------------------------------------------------------

(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-StartUndoMark ActDoc)
(initget "Select")
(if (setq StPt (getpoint "\n Select first point [Select existing polyline]: "))
 (if (= StPt "Select")
  (while
   (if
    (and
     (setq Sel (entsel "\n Select polyline: "))
     (setq EntData (entget (car Sel)))
     (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
    )
    (progn
     (setq PolyObj (vlax-ename->vla-object (car Sel)))
     nil
    )
    T
   )
  )
  (progn
   (setq PtList (cons StPt PtList))
   (while (setq Pt (getpoint StPt "\n Select next point: "))
    (setq PtList (cons Pt PtList))
    (if (> (length PtList) 1)
     (grdraw (cadr PtList) (car PtList) 1)
     (grdraw StPt Pt 1)
    )
   )
   (grdraw (car PtList) StPt 1)
   (foreach Pt PtList
    (setq CoordList (cons (cadr Pt) CoordList))
    (setq CoordList (cons (car Pt) CoordList))
   )
   (setq PolyObj
    (vlax-invoke
     (vlax-get
      ActDoc
      (if (equal (getvar "cvport") 1)
       'PaperSpace
       'ModelSpace
      )
     )
     'AddLightweightPolyline
     CoordList
    )
   )
   (vla-put-Closed PolyObj :vlax-true)
  )
 )
)
(setq Dict (vlax-invoke PolyObj 'GetExtensionDictionary))
(if (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "RoomInformation"))))
 (setq xRec (vlax-invoke Dict 'AddXRecord "RoomInformation"))
 (setq ExInfo (MyGetXRec Xrec))
)
(setq XrecList ; (cons [assoc code to use] [question to ask])
 (list
  (cons 1 "\n Room Name:")
  (cons 2 "\n Room Number:")
 )
)
(foreach pair XrecList
 (setq tmpExInfo (cdr (assoc (car pair) ExInfo)))
 (if
  (/=
   (setq tmpStr
    (getstring T
     (strcat
      (cdr pair)
      (if tmpExInfo
       (strcat "<" tmpExInfo ">: ")
       " "
      )
     )
    )
   )
   ""
  )
  (progn
   (setq CodeList (cons (car pair) CodeList))
   (setq DataList (cons tmpStr DataList))
  )
  (if tmpExInfo
   (progn
    (setq CodeList (cons (car pair) CodeList))
    (setq DataList (cons tmpExInfo DataList))
   )
  )
 )
)
(setq CodeList (cons 40 CodeList))
(setq DataList (cons (vlax-get PolyObj 'Area) DataList))
(MySetXRec Xrec (reverse CodeList) (reverse DataList))
(print (MyGetXrec Xrec))
(princ)
)


[caddesk2000]

I just want to say, you people are amazing.  Do you ever get the feeling that your coming to the top of a hil, only to find a mountain and a canyon just on the other side.  It's nice to have a group like this for feedback.  I'm new here, but I'm sure I'll be spending lots of time with you guys/gals.

Have a great day
Sam Cutbirth