Read attribute value, create string and write into a different block as attribute value

Raul_Niembro · ‎11-17-2024

i've been struggling with a code. the general idea is to create a string using the block name, and 1 or 2 attribute values (if the second doesnot exist, skip)

Here's the code

(defun c:Rced ()
(while t
;; Select first block
(setq bloq1 (entsel "\nSelect the first block: "))
(if (not bloq1) (exit))
(setq bloq1 (car bloq1))
(setq bloqD1 (entget bloq1))

;; Get name of first block and store as IN1
(setq IN1 (cdr (assoc 2 bloqD1)))

;; Initialize attribute variables
(setq IN2 "" IN3 "" CIR "")
(setq atrb (entnext bloq1))
(while atrb
(setq atrbD (entget atrb))
(cond
((eq (cdr (assoc 2 atrbD)) "Control") (setq IN2 (cdr (assoc 1 atrbD))))
((eq (cdr (assoc 2 atrbD)) "Consecutivo") (setq IN3 (cdr (assoc 1 atrbD))))
((eq (cdr (assoc 2 atrbD)) "Circuito") (setq CIR (cdr (assoc 1 atrbD))))
)
(setq atrb (entnext atrb))
)

;; Select second block
(setq bloq2 (entsel "\nSelect the second block: "))
(if (not bloq2) (exit))
(setq bloq2 (car bloq2))
(setq bloqD2 (entget bloq2))

;; Get name of second block and store as FI1
(setq FI1 (cdr (assoc 2 bloqD2)))

;; Initialize attribute variables
(setq FI2 "" FI3 "")
(setq atrb (entnext bloq2))
(while atrb
(setq atrbD (entget atrb))
(cond
((eq (cdr (assoc 2 atrbD)) "Control") (setq FI2 (cdr (assoc 1 atrbD))))
((eq (cdr (assoc 2 atrbD)) "Consecutivo") (setq FI3 (cdr (assoc 1 atrbD))))
)
(setq atrb (entnext atrb))
)

;; Create text string INI
(setq INI (strcat IN1 " " IN2))
(if (not (equal IN3 "")) (setq INI (strcat INI " " IN3)))

;; Create text string SFI
(setq SFI (strcat FI1 " " FI2))
(if (not (equal FI3 "")) (setq SFI (strcat SFI " " FI3)))

;; Select destination block
(setq Cedula (entsel "\nSelect the destination block: "))
(if (not Cedula) (exit))
(setq Cedula (car Cedula))
(setq CedulaD (entget Cedula))

;; Apply values to destination block
(setq atrb (entnext Cedula))
(while atrb
(setq atrbD (entget atrb))
(cond
((and (eq (cdr (assoc 2 atrbD)) "SI") (not (equal INI ""))) (entmod (subst (cons 1 INI) (assoc 1 atrbD) atrbD)))
((and (eq (cdr (assoc 2 atrbD)) "SF") (not (equal SFI ""))) (entmod (subst (cons 1 SFI) (assoc 1 atrbD) atrbD)))
((and (eq (cdr (assoc 2 atrbD)) "Circuito") (not (equal CIR ""))) (entmod (subst (cons 1 CIR) (assoc 1 atrbD) atrbD)))
)
(setq atrb (entnext atrb))
)
)
(princ)
)

paullimapa · ‎11-17-2024

So are you getting an error msg when you run the lisp function?

Do you know where exactly it fails?

Perhaps you’re just missing at the end

(entupd Cedula)

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos

komondormrex · ‎11-17-2024

check this improvised variation on your subject

(defun c:rced (/ block_1 block_1_name tag_value_1 block_2 block_2_name tag_value_2 ini sfi dest_block)
  (defun get_att_listed (insert_ename tag_list)
    	(setq tag_list (mapcar '(lambda (tag) (cons tag "")) tag_list))
  	(foreach att (vlax-invoke (vlax-ename->vla-object insert_ename) 'getattributes)
		 (if (assoc (setq tag (vla-get-tagstring att)) tag_list)
		   	(setq tag_list (subst (cons tag (vla-get-textstring att)) (cons tag "") tag_list))
		 )
  	)
    	tag_list
  )
  (defun put_att_listed (insert_ename tag_list / tag_value)
	(foreach att (vlax-invoke (vlax-ename->vla-object insert_ename) 'getattributes)
		 (if (setq tag_value (assoc (setq tag (vla-get-tagstring att)) tag_list))
		   	(vla-put-textstring att (cdr tag_value))
		 )
	)
  )
  (while (and 	(setq block_1 (car (entsel "\nSelect the first block: ")))
		(setq block_2 (car (entsel "\nSelect the second block: ")))
	 )
	  (setq block_1_name (vla-get-effectivename (vlax-ename->vla-object block_1))
		tag_value_1 (get_att_listed block_1 '("Control" "Consecutivo" "Circuito")) 
		block_2_name (vla-get-effectivename (vlax-ename->vla-object block_2))
		tag_value_2 (get_att_listed block_1 '("Control" "Consecutivo"))
		ini (vl-string-right-trim " " (strcat block_1_name " " (cdar tag_value_1) " " (cdadr tag_value_1)))
		sfi (vl-string-right-trim " " (strcat block_2_name " " (cdar tag_value_2) " " (cdadr tag_value_2)))
		dest_block (car (entsel "\nSelect the destination block: "))
	  )
	  (put_att_listed dest_block (list (cons "SI" ini) (cons "SF" sfi) (cons "Circuito" (cdaddr tag_value_1))))
  )
)

paullimapa · ‎11-17-2024

saw a few areas which would cause the routine to stumble.

First I would localize all the variables like this:

(defun c:Rced 
  (/ bloq1 bloqD1 IN1 IN2 IN3 CIR atrb atrbD bloq2 bloqD2 FI1 FI2 FI3 INI SFI Cedula CedulaD) ; localize variables

I also prefer to use the ssget function to filter out only blocks with attributes in the selection. This is something that I have change in your code for all 3 block selections:

    ;; Select first block
;    (setq bloq1 (entsel "\nSelect the first block: "))
;    (if (not bloq1) (exit))
;    (setq bloq1 (car bloq1))
;    (setq bloqD1 (entget bloq1))
; use this instead
    (princ "\nSelect the first block: ")
    (if(setq bloq1 (ssget "_+.:E:S" '((0 . "INSERT")(66 . 1)))) ; filter selection to blocks with attributes
     (setq bloqD1 (entget (setq bloq1 (ssname bloq1 0))))
     (exit)
    ) ; if
;

In case the block is dynamic:

    ;; Get name of first block and store as IN1
;    (setq IN1 (cdr (assoc 2 bloqD1)))
; to accommodate for dynamic blocks
     (setq IN1 (vla-get-effectivename (vlax-ename->vla-object bloq1)))
;

When you're looping through for attributes:

    (while atrb
      (setq atrbD (entget atrb))
; add this
      (if (/= (cdr(assoc 0 atrbD)) "SEQEND") 
       (progn
;
      (cond
        ((eq (cdr (assoc 2 atrbD)) "Control") (setq IN2 (cdr (assoc 1 atrbD))))
        ((eq (cdr (assoc 2 atrbD)) "Consecutivo") (setq IN3 (cdr (assoc 1 atrbD))))
        ((eq (cdr (assoc 2 atrbD)) "Circuito") (setq CIR (cdr (assoc 1 atrbD))))
      )
      (setq atrb (entnext atrb))
; add this
     ) ; progn
     (setq atrb nil)
   ) ; if
;
    )

Lastly the entmod statements:

    (while atrb
      (setq atrbD (entget atrb))
; add this
      (if (/= (cdr(assoc 0 atrbD)) "SEQEND") 
       (progn
;
      (cond
;        ((and (eq (cdr (assoc 2 atrbD)) "SI") (not (equal INI ""))) (entmod (subst (cons 1 INI) (assoc 1 atrbD) atrbD)))
;        ((and (eq (cdr (assoc 2 atrbD)) "SF") (not (equal SFI ""))) (entmod (subst (cons 1 SFI) (assoc 1 atrbD) atrbD)))
;        ((and (eq (cdr (assoc 2 atrbD)) "Circuito") (not (equal CIR ""))) (entmod (subst (cons 1 CIR) (assoc 1 atrbD) atrbD)))
; modified to these
        ((and (eq (cdr (assoc 2 atrbD)) "SI") (not (equal INI ""))) (entmod (setq atrbD (subst (cons 1 INI) (assoc 1 atrbD) atrbD))))
        ((and (eq (cdr (assoc 2 atrbD)) "SF") (not (equal SFI ""))) (entmod (setq atrbD (subst (cons 1 SFI) (assoc 1 atrbD) atrbD))))
        ((and (eq (cdr (assoc 2 atrbD)) "Circuito") (not (equal CIR ""))) (entmod (setq atrbD (subst (cons 1 CIR) (assoc 1 atrbD) atrbD))))
;
      )
      (setq atrb (entnext atrb))
; add this
     ) ; progn
     (setq atrb nil)
    ) ; if
   )

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos

Sea-Haven · ‎11-17-2024

@paullimapa I try these days to localise my variables so thought why not sort them alphabetically, so wrote this have your code open in say notepad add all your variable names, then copy all those names to clipboard and run this little bit of code, the last line you can copy and paste back into to your code.

bloq1 bloqD1 IN1 IN2 IN3 CIR atrb atrbD bloq2 bloqD2 FI1 FI2 FI3 INI SFI Cedula CedulaD

ATRB ATRBD BLOQ1 BLOQ2 BLOQD1 BLOQD2 CEDULA CEDULAD CIR FI1 FI2 FI3 IN1 IN2 IN3 INI SFI

Caps occur using Read will play a bit more.

; Sort var names by AlanH Nov 2024

(defun makevars ( / csv->lst str lst)
; thanks Lee-mac
(defun csv->lst ( str / pos )
(if (setq pos (vl-string-position 32 str))
    (cons (substr str 1 pos) (csv->lst (substr str (+ pos 2))))
    (list str)
    )
)
(setq str (getstring T "\nPaste the variable names "))
(setq lst (csv->lst  str))
(setq lst (acad_strlsort lst))
(setq str2 '())
(foreach val lst
(setq str2 (cons (read val) str2))
)
(princ "\nCopy and paste the next line/s as sorted variable names ")
(princ "\n")
(princ (reverse str2))
(princ)
)
(makevars)

Tested on 68 local variable names.

paullimapa · ‎11-17-2024

Very nice addition to my library…thanks

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos

paullimapa · ‎11-17-2024

I made the following modifications so it'll return without changing the case:

; makevars
; Sort var names by AlanH Nov 2024
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/read-attribute-value-create-string-and-write-into-a-different/m-p/13156128/highlight/true#M474908
(defun makevars ( / csv->lst str lst)
; thanks Lee-mac
(defun csv->lst ( str / pos )
(if (setq pos (vl-string-position 32 str))
    (cons (substr str 1 pos) (csv->lst (substr str (+ pos 2))))
    (list str)
    )
)
(setq str (getstring T "\nPaste the variable names: "))
(setq lst (csv->lst  str))
(setq lst (acad_strlsort lst))
;(setq str2 '())
;(foreach val lst
;(setq str2 (cons (read val) str2))
;)
(setq str2 "")
(foreach val lst
(setq str2 (strcat str2 " " val))
)
(setq str2 (strcat "(" (substr str2 2) ")"))
(princ "\nCopy and paste the next line/s as sorted variable names: ")
(princ "\n")
;(princ (reverse str2))
(princ str2)
(princ)
)
(makevars)

Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos

Sea-Haven · ‎11-18-2024

Thanks ran out of time saved new version.

Community

Read attribute value, create string and write into a different block as attribute value

Read attribute value, create string and write into a different block as attribute value

Read attribute value, create string and write into a different block as attribute value