LISP for adding attributes to a block from Xdata

hbc85 · ‎05-25-2023

Hi.

Im having trouble getting this code to work.
Can anyone look at it for me?

(defun get_xdata_object ()
(setq blks nil)
(and
(setq ss (ssget '((0 . "INSERT"))))
(setq i (sslength ss))
(while (> i 0)
(setq blk (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
(if (not (vl-position blk blks))(setq blks (cons blk blks)))
)
);end and
(foreach blk blks
(vl-load-com)
(setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
(setq ent (vlax-ename->vla-object (ssname ss 0)))
); end foreach
(setq xdata-line (car (entsel "\nSelect line containing XData: ")))

);End Defun

(defun addattrtest1 (def)
(foreach blk blks
(vl-load-com)
(setq tag1 (cdr (assoc "searchtag1" (get_xd_list xdata-line))))
(vla-addattribute def
2.5
acAttributeModeInvisible
"searchtag1"
(vlax-3D-point 0 0)
"searchtag1"
tag1 ; use the value of searchtag1 as the attribute value
)
(princ)
);end foreach
);End Defun

(defun addattrtest2 (def)
(foreach blk blks
(vl-load-com)
(setq tag2 (cdr (assoc "searchtag2" (get_xd_list xdata-line))))
(vla-addattribute def
2.5
acAttributeModeInvisible
"searchtag2"
(vlax-3D-point 0 0)
"searchtag2"
tag2 ; use the value of searchtag2 as the attribute value
)
(princ)
);end foreach
);End Defun

(defun addattrtest3 (def)
(foreach blk blks
(vl-load-com)
(setq tag3 (cdr (assoc "searchtag3" (get_xd_list xdata-line))))
(vla-addattribute def
2.5
acAttributeModeInvisible
"searchtag3"
(vlax-3D-point 0 0)
"searchtag3"
tag3 ; use the value of searchtag3 as the attribute value
)
(princ)
);end foreach
);End Defun

(defun refreshblock (blk)
(vl-load-com)
(command "_.attsync" "_N" blk)
);End Defun

(defun c:addattrtest ( )
;(setq *error* 'xx:Error)
(initget 1 "Option1 Option2 Option3 All3")
(setq option (getkword "\nHvilken Attributt pakke vil du legge til 3D solid?:[Option1/Option2/Option3/All3]"))
(cond ((= option "Option1") (get_xdata_object)(addattrtest1)(refreshblock))
((= option "Option2") (get_xdata_object)(addattrtest2)(refreshblock))
((= option "Option3") (get_xdata_object)(addattrtest3)(refreshblock))
((= option "All3") (get_xdata_object)(addattrtest1)(addattrtest2)(addattrtest3)(refreshblock))
(t (princ "Invalid option")))
; (*error* "end")
);End Defun

What i want to do is post attributes from xdata.
it askes to choose a block first. then the line with xdata in.
i cant post an example drawing unfortunately because its for work.
But as im having trouble with adding alot off attributes at a time. I modified my original code and splitt it up to hopefully get it more user friendly.
im also having trouble with trying to get it to just move on if it encounters a NIL.
originally every option adds 8 attributes at a time. But i cut it down to not make the code so long here.
For some reason i cant get it to work for more then 8 at a time..
the command "get_xd_list" is our call command for xdata for the costum program my work place use. So i dont need an reference to it anyplace in my code.

the error im getting is:
Command: ADDATTRTEST
Hvilken Attributt pakke vil du legge til 3D solid?:[Option1/Option2/Option3/Alle3]A
Select objects: 1 found
Select objects:
Select line containing XData: ; error: too few arguments
Command:

any advice is much appretiated.

komondormrex · ‎05-25-2023

what is 'the line with xdata in'?

hbc85 · ‎05-25-2023

Hi. Thank you for asking. I forgot to write that. I have a 3d solid that i have made in to a block. And those 3d solids have been made from a polyline. And that polyline have all the xdata imbedded inside.

komondormrex · ‎05-25-2023

a block example would be nice to start over

hbc85 · ‎05-26-2023

I think i can post this one.

And i use a modefied version of the code found on this forum here:

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/a-lisp-routine-to-create-a-block-fro...

to make a block out of that solid.

The example drawing has 4 entities.

2x2 are the same.

I just made a block out of the solid.

And the other one is just a copy if how it was before making the block.

komondormrex · ‎05-26-2023

you've got a holly bunch of xd in this one. which of these are you going to convert into attributes?

Moshe-A · ‎05-26-2023

@hbc85 hi,

(get_xd_list) function is missing

((= option "All3") (get_xdata_object)(addattrtest1)(addattrtest2)(addattrtest3)(refreshblock))

each of these calls (blue) is missing the 'def' argument.

??

Moshe

hbc85 · ‎05-26-2023

(get_xd_list) function. like i originally said is a local function call to get data from the xdata made costum for us.

So you wont be able to test that part without having that custum program installed on your autocad.

i want the option to really add all tags.

im working on trying to get the company over to inventor.

So all the xdata needs to go over to vault\inventor in some way. And looks like attributes is the way to go at it.

hbc85 · ‎05-26-2023

haha. pushed the wrong botton for acception solution.

the picture shows all yes. but not the whole picture.

komondormrex · ‎05-26-2023

was wondering too)

hbc85 · ‎05-26-2023

komondormrex · ‎05-26-2023

well, it was obvious from the very start) so every paired xd to attribute?

komondormrex · ‎05-26-2023

opps) you are 1st)

hbc85 · ‎05-26-2023

Yea. Like this:

i want to expand on that as i want to be able to choose later what tag to really convert or choose all.
But i thought making that code to be built this way might work?
Today i have it splitt 3 ways with posting 8 attributes per time.
But for every splitt you have to choose the xdata line and block over again (becouse you are basically just starting 3 indipendent codes) . So if i want more i needs it to be splitt more. And there for having to do that more often. I want to be able to build/coded in a way that it can expand more.

another option was also to export a csv file and import as attributes. But i could not really get that to work.

But in that way i would not have to manually code in every tag depending on the object.

hbc85 · ‎05-26-2023

Wrote more about my over all goal here:
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/getting-code-to-go-threw-a-selection...

long read because i cant just write something short. 😂🤣😅😅

Moshe-A · ‎05-26-2023

@hbc85 hi,

Tell you what i think you need 🤣 a functions to read & write to xdata. so here is a very nice one from

MENZI ENGINEERING GmbH, Switzerland since 2004.

enjoy

Moshe

; extended data (xdata)

; == Function MeGetXdata
; Reads Xdata from an entity.
; Copyright:
;   ©2004 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   Obj = Object to read Xdata from [VLA-OBJECT]
;   App = AppID [STR]
; Return [Type]:
;   > List of Xdata '((F1 . D1)...(Fx . Dx)) [LIST]
;   > False if no Xdata found
; Notes:
;   - App argument "" gets all Xdata from an object
;
(defun MeGetXdata (Obj App / DatArr FldArr)
 (vla-GetXData Obj App 'FldArr 'DatArr)
 (if (and FldArr DatArr)
  (mapcar
  '(lambda (f v) (cons f v))
   (vlax-safearray->list FldArr)
   (mapcar
   '(lambda (l)
     (if (= (logand (vlax-variant-type l) vlax-vbArray) vlax-vbArray)
      (vlax-safearray->list (vlax-variant-value l))
      (vlax-variant-value l)
     )
    ) (vlax-safearray->list DatArr)
   )
  )
 )
)

;
; == Function MeSetXdata
; Writes Xdata into an entity.
; Copyright:
;   ©2004 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   Obj = Object to write Xdata [VLA-OBJECT]
;   Lst = Xdata list '((F1 . D1)...(Fx . Dx)) [LIST]
; Return [Type]:
;   > True if succeed
;   > False if fail
; Notes:
;   - To delete Xdata, call the function with AppId only:
;     (MeSetXdata Obj '((1001 . "MyAppId")))
;
(defun MeSetXdata (Obj Lst / FldArr DatArr)
 (setq FldArr (MeConvToXlist (mapcar 'car Lst) vlax-vbInteger)
       DatArr (MeConvToXlist (mapcar 'cdr Lst) vlax-vbVariant)
 )
 (not
  (vl-catch-all-error-p
   (vl-catch-all-apply 'vla-SetXData (list Obj FldArr DatArr))
  )
 )
)
;
; == Function MeConvToXlist
; Converts a list to an array for XDatas.
; Copyright:
;   ©2004 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   Dat = Data list [LIST]
;   Typ = Variable type [INT]
; Return [Type]:
;   > Data array [SAFEARRAY]
; Notes:
;   None
;
(defun MeConvToXlist (Dat Typ)
 (vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray Typ (cons 0 (1- (vl-list-length Dat))))
   (mapcar
   '(lambda (l)
     (if (= (type l) 'LIST)
      (vlax-safearray-fill
       (vlax-make-safearray vlax-vbDouble (cons 0 (1- (vl-list-length l))))
       l
      )
      l
     )
    ) Dat
   )
  )
 )
)

hbc85 · ‎05-26-2023

Hi. Thank you for this.
but this reads and writes xdata.
i need to write attributes from xdata.
As the system im on already reads and writes to xdata

Do you have anything like that?
reads xdata.
Write tag with value as attribute to an object\block?

komondormrex · ‎05-26-2023

well, i think a drop of dopamine will be fine for a friday night)

get_xd_data reads xd the way they are in your 2d pline example only.

all attributes are placed at block's insertion point.

;******************************************************************************************************************

(defun get_xd_data ( ename / all_xd_list xd_raw_list xd_paired_list)
	(if (setq all_xd_list (assoc -3 (entget ename (list "*"))))
		(foreach each_xd (cadr all_xd_list)
			(if (and
			    	 (= 'list (type each_xd))
				 (/= "{" (cdr each_xd))
				 (/= "}" (cdr each_xd))
			    )
				(setq xd_raw_list
				     (append
				     	xd_raw_list
					(list (vl-princ-to-string (cdr each_xd)))
				     )
				)
			)
		)
	)
	(repeat (/ (length xd_raw_list) 2)
	  	(setq xd_paired_list (append xd_paired_list (list (cons (car xd_raw_list) (cadr xd_raw_list))))
		      xd_raw_list (cddr xd_raw_list)
	        )
	)
  	xd_paired_list
)

;******************************************************************************************************************

(defun c:xd_to_attributes (/ target_block xd_paired_list )
	(setq target_block (vlax-ename->vla-object (car (entsel "\nPick target block: ")))
	      xd_paired_list (get_xd_data (car (entsel "\nPick entity with XData: ")))
        )
  	(foreach xd_pair xd_paired_list
		(vla-addattribute (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
					    (vla-get-effectivename target_block)
			    	  )
				  2.5
		  		  acAttributeModeVerify
		  		  (car xd_pair)
		  		  (vla-get-insertionpoint target_block)
		  		  (car xd_pair)
		  		  (cdr xd_pair)
	  	)
	)
  	(command "_attsync" "_n" (vla-get-effectivename target_block))  
  	(princ)
)

;******************************************************************************************************************

hbc85 · ‎05-26-2023

OMG.

Thank you so much. this was more then asked for really. Thank you thank you!

This really made my day\week\month. been working on and off with this sense march really. Thank you so much.

komondormrex · ‎05-26-2023

your welcome)

Community

LISP for adding attributes to a block from Xdata

LISP for adding attributes to a block from Xdata

LISP for adding attributes to a block from Xdata