Choosing a linked entity and make a block and add attributes

[hbc85]

hi. 

So im trying i make a solid in to a block and for it to choose a poly line that it is linked to, to get its block name from and attributes from.

i have these single part of codes im using to do this by hand:

;------------------------------------------------------------------------------------------------------------------------------------;
;original origin of the code: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/a-lisp-routine-to-create-a-block-from-selected-objectes-and/td-p/11026565
;makes a solid as a block
;choose solid first. then choose the polyline with xdata in. then it copies
;the name from tag "objectid" and makes that the name of the block. 
;It adds a number of more if the same block exist with the same name
;edited with help from chatGPT from the original code.

;------------------------------------------------------------------------------------------------------------------------------------;
(defun c:3DBLOCK (/ *error* errmsg :getblockanonymname s p n newname suffix count obj)
  
  (defun *error* (errmsg)
    ;(setq *error* 'xx:Error)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (setvar 'cmdecho 1)
    (princ))
  
  (defun :getblockanonymname ( / d r n)
    (while (setq d (tblnext "BLOCK" (null d)))
      (if (wcmatch (setq n (cdr (assoc 2 d))) "C$*")
	(setq r (cons n r))))
    (cond ((car (vl-sort r '>)))
	  ("C$1000")))
  
  (if (and (setq s (ssget))
	  (setq p '(0 0 0))
	  (setq n (cdr (assoc "OBJECTID" (get_xd_list (car (entsel))))))
	  (setvar 'cmdecho 0)
	  )
    (progn
      (setq newname n)
      (setq suffix "")
      (setq count 0)
      (while (tblsearch "BLOCK" newname)
	(setq count (1+ count))
	(setq suffix (strcat "_" (itoa count)))
	(setq newname (strcat n suffix)))
      (command "_.-BLOCK" newname "_non" p s ""
	       "_.-INSERT" newname "_s" 1 "_r" 0 "_non" p)
      (princ (strcat "\nBlock created '" newname " '"))
      )
    )
  (*error* "end")
  );End Defun

And i have this code with help from this forum (user: komondormrex ) : 

;------------------------------------------------------------------------------------------------------------------------------------;
;oreign of the code; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-for-adding-attributes-to-a-block-from-xdata/m-p/11991187/highlight/true#M448945
;Copies xdata from a polyline and post it as attributes in to a block that is created from a 3D solid.
;Askes to choose solid first. Then Xdata line.
;------------------------------------------------------------------------------------------------------------------------------------;
(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
)

i want to link these prosseses by doing this:

activate the program/lisp.

fence or/and single choose solids.
it finds the linked polyline and gets its name from that line, makes the block, then starts the attribute adding from xdata from that same polyline.
i have posted an example drawing.

i need it to ignore adding the polyline in to the block.
Also. in the example i have added a weld line that we use that also reads as a polyline and is linked to the solid. But its in a different layer. 
i have made a "finished" product and colored it red. But the code do NOT have to color anything as i only did it to show difference between the two. 

is this possible to do?

[komondormrex · Accepted solution]

well, hello again.

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

(defun get_xdata ( ename / all_xd_list xd_raw_list xd_paired_list)
	(if (setq all_xd_list (assoc -3 (entget ename (list "CAJAC2000"))))
		(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 xd_to_attributes (block_definition_object 2dpline_ename / xd_paired_list)
	(setq xd_paired_list (get_xdata 2dpline_ename))
  	(foreach xd_pair xd_paired_list
		(vla-addattribute block_definition_object
				  		  2.5
		  		  		  acAttributeModeInvisible
		  		  		  (car xd_pair)
						  (vlax-3d-point '(0 0 0))
		  		  		  (car xd_pair)
		  		  		  (cdr xd_pair)
	  	)
	)
  	(princ)
)

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

(defun define_block (3dsolid_ename 2d_pline_ename / block_name block_name_suffix 3dsolid_block_definition)
	(setq block_name (cdr (assoc "OBJECTID" (get_xdata 2d_pline_ename)))
		  block_name_suffix (1+ (cdr (assoc "Last_Block_Created_Suffix"
		  									(vlax-ldata-list (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
								 	 )
								)
							)
	)
	(while (if (vl-catch-all-error-p (vl-catch-all-apply
											'vla-item
	   										(list
												(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
	   											(strcat block_name "_" (suffix_to_string block_name_suffix 3))
	   										)
									 )
			    )
				nil
				(setq block_name_suffix (1+ block_name_suffix))
			)
	)
	(vlax-ldata-put (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
					"Last_Block_Created_Suffix"
					block_name_suffix
	)
	(setq 3dsolid_block_definition (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
								   			(vlax-3d-point '(0 0 0))
								 			(setq block_name (strcat block_name "_" (suffix_to_string block_name_suffix 3)))
								   )
	)
  	(vlax-invoke (vla-get-activedocument (vlax-get-acad-object))
		     'copyobjects
		     (list (vlax-ename->vla-object 3dsolid_ename))
		     (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) block_name)
	)
	3dsolid_block_definition
)

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

(defun suffix_to_string (suffix str_length / zeroes)
	(setq zeroes "")
	(repeat str_length (setq zeroes (strcat zeroes "0")))
	(if (<= 0 (- str_length (strlen (itoa suffix))))
			(strcat (substr zeroes 1 (- str_length (strlen (itoa suffix)))) (itoa suffix))
			(itoa suffix)
	)
)

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

(defun c:make_attributed_block (/ 3dbox_2dpoly_sset 3dbox_2dpoly_assoc_list 3dsolid_block_definition block_reference)
	(if (setq 3dbox_2dpoly_sset (ssget '((0 . "3dsolid,polyline"))))
		(progn
			(setq 3dbox_2dpoly_assoc_list (mapcar '(lambda (ename) (cons (cdr (assoc 0 (entget ename))) ename))
											 	   (vl-remove-if 'listp (mapcar 'cadr (ssnamex 3dbox_2dpoly_sset)))
										  )
			)
			(if (null (cdr (assoc "Last_Block_Created_Suffix" (vlax-ldata-list (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))))
					(vlax-ldata-put (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) "Last_Block_Created_Suffix" 0)
			)
			(setq 3dsolid_block_definition (define_block (cdr (assoc "3DSOLID" 3dbox_2dpoly_assoc_list))
												(cdr (assoc "POLYLINE" 3dbox_2dpoly_assoc_list))
										   )
			)
			(princ (strcat "Block \"" (vla-get-name 3dsolid_block_definition) "\" definition has been created.\n"))
			(xd_to_attributes 3dsolid_block_definition (cdr (assoc "POLYLINE" 3dbox_2dpoly_assoc_list)))
			(setq block_reference (vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							 									  (vlax-3d-point '(0 0 0))
							 									  (vla-get-name 3dsolid_block_definition)
							 									  1 1 1 0
								  )
			)
			(princ (strcat "Block \"" (vla-get-name block_reference) "\" has been inserted.\n"))
			(entmod (append (entget (vlax-vla-object->ename block_reference)) (list (assoc -3 (entget (cdr (assoc "3DSOLID" 3dbox_2dpoly_assoc_list)) (list "*"))))))
			(vla-erase (vlax-ename->vla-object (cdr (assoc "3DSOLID" 3dbox_2dpoly_assoc_list))))
			(vla-erase (vlax-ename->vla-object (cdr (assoc "POLYLINE" 3dbox_2dpoly_assoc_list))))
		)
		(alert "Nothing's been selected.")
	)
	(princ)
)

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

[hbc85]

hi again.

thanks so much for all your hard work.

is there anything i can do for you?

Im getting an error when trying this':

Select objects:
; error: bad argument type: lentityp nil
Command:

[komondormrex]

you need to select both 3dsolid and 2dpline. one pair at a time. 

[komondormrex]

@hbc85 

oops, i missed a 2dpline xd's linked handle to 3dsolid) that will simplify selecting to only 2dpline in bulk.

[hbc85]

Hi. Thank you for your continued help.

I noticed while testing different models yesterday that some people have also used a normal line for, for example tubes and beams. Witch from my original training when i started here was a no no. So i did not think of it.

Is it still possible to add so it does the same with a line?

Also it adds a number at the end of the name. I would like if possible that it dont do that unless its a block that already exist on the drawing.