Copy a specific attr to an other attr of other blocks

[braudpat]

Hello

I have (and have found) many routines to copy value from attrs to other attrs of other blocks ! 

But all routines found are testing the Tagname destination attr to be the same !

So I need something slighly different ... 

1) Select graphically ONE attribute (from a classic or dynamic Block) 

2) Select many other Blocks (classic or dynamic) 

3) Ask for the destination attr tagname ...

Which is very often different from the source tagname attribute

4) Copy the value to the N destination blocks which have this specific attribute !

Thanks in advance for your effort !

THE HEALTH, Regards, Patrice

[pbejse · Accepted solution]

---

@braudpat wrote:

1) Select graphically ONE attribute (from a classic or dynamic Block) 

2) Select many other Blocks (classic or dynamic) 

3) Ask for the destination attr tagname ...

Which is very often different from the source tagname attribute

---

(defun c:ThisToThat (/ TagSource TagString TagTarget TargetBlocks)

  (if (and
	(setq TagSource (car (nentselp "\nSelect Attribute")))
	(eq "ATTRIB" (cdr (assoc 0 (setq ent (entget TagSource)))))
	(setq TagString (Cdr (Assoc 1 ent)))
	(princ "\nSelect Attribute Blocks to process")
	(setq TargetBlocks (ssget "_:L" '((0 . "INSERT") (66 . 1))))
	(setq TagTarget (strcase (getstring "\nEnter target TAG name: ")))
      )
    (repeat (setq i (sslength TargetBlocks))
      (vl-some
	'(lambda (atb)
	   (if (eq (strcase (vla-get-tagstring atb)) TagTarget)
	     (progn
	       (setq b (vla-get-textstring atb))
	       (Vla-put-textstring atb TagString)
	       (princ
		 (strcat "\nReplaced " b) 
	       )
	     )
	   )
	 )
	(vlax-invoke
	  (vlax-ename->vla-object
	    (ssname TargetBlocks (setq i (1- i)))
	  )
	  'GetAttributes
	)
      )
    )
  )
  (princ)
)

 HTH

[braudpat]

Hello @pbejse 

THANKS your VLisp Routine is "perfect" !

THANKS again for your fast answer !

THE HEALTH (Stay Safe, Stay Home, Stay Live), Regards, Patrice (The Retired Old French EE Froggy)

[pbejse]

---

@braudpat wrote:

THANKS your VLisp Routine is "perfect" !

---

You are welcome @braudpat , curious you emphasize Vlips. Are you more comfortable vanilla flavored lisp?

We can write a quick one for that too if needed

[braudpat]

Hello

I am at level 0.2 in Lisp et level 0.0 in VLisp !

I have programmed with AutoLisp a few years between 1990-1998 and today I have almost all forgotten !!

THANKS, THE HEALTH, Regards, Patrice

[pbejse]

---

@braudpat wrote:

I am at level 0.2 in Lisp et level 0.0 in VLisp !

---

FWIW

(defun c:ThatToThese (/ TagSource TagString TagTarget TargetBlocks found blk enx)

  (if (and
	(setq TagSource (car (nentselp "\nSelect Attribute")))
	(eq "ATTRIB" (cdr (assoc 0 (setq ent (entget TagSource)))))
	(setq TagString (Cdr (Assoc 1 ent)))
	(princ "\nSelect Attribute Blocks to process")
	(setq TargetBlocks (ssget "_:L" '((0 . "INSERT") (66 . 1))))
	(setq TagTarget (strcase (getstring "\nEnter target TAG name: ")))
      )
    (repeat (setq i (sslength TargetBlocks))
      	(setq found nil blk (ssname TargetBlocks (setq i (1- i))))
	    (while
	        (and
	            (null found)
	            (setq blk (entnext blk))
	            (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
	        )
	        (if (= TagTarget (strcase (cdr (assoc 2 enx))))
	            (if (entmod (subst (cons 1 TagString) (assoc 1 (reverse enx)) enx))
	                (progn
	                    (entupd blk)
	                    (setq found TagString)
	                )
	            )
	        )
	    )
       )
    )
  (princ)
  )

---

@braudpat wrote:

I have programmed with AutoLisp a few years between 1990-1998 and today I have almost all forgotten !!

---

One must think that coding is like riding a bike... 🙂 

I'm sure its still there.

[braudpat]

Hello

Please is it possible to get a sligthly updated version ?

No question about destination attribut !
Copy directly to the FIRST attribut of destination selected Blocks ...

Thanks, Regards, Patrice

[pbejse · Accepted solution]

---

@braudpat wrote:

No question about destination attribut !
Copy directly to the FIRST attribut of destination selected Blocks ...

---

(defun c:HereAndThere (/ TagSource TagString TargetBlocks)
  (and
    (setq TagSource (car (nentselp "\nSelect Attribute")))
    (eq "ATTRIB" (cdr (assoc 0 (setq ent (entget TagSource)))))
    (setq TagString (Cdr (Assoc 1 ent)))
    (princ "\nSelect Attribute Blocks to process")
    (setq TargetBlocks (ssget "_:L" '((0 . "INSERT") (66 . 1))))
    (princ (strcat "\n"
		   (itoa (setq i (sslength TargetBlocks)))
		   " item(s) replaced with "
		   TagString
	   )
    )
    (repeat i
      (Vla-put-textstring
	(Car (vlax-invoke
	       (vlax-ename->vla-object
		 (ssname TargetBlocks (setq i (1- i)))
	       )
	       'GetAttributes
	     )
	)
	TagString
      )
    )
  )
  (princ)
)

(defun c:ThenAndNow (/ TagSource TagString  TargetBlocks found blk enx)
  (and
    (setq TagSource (car (nentselp "\nSelect Attribute")))
    (eq "ATTRIB" (cdr (assoc 0 (setq ent (entget TagSource)))))
    (setq TagString (Cdr (Assoc 1 ent)))
    (princ "\nSelect Attribute Blocks to process")
    (setq TargetBlocks (ssget "_:L" '((0 . "INSERT") (66 . 1))))
    (princ (strcat "\n"
		   (itoa (setq i (sslength TargetBlocks)))
		   " item(s) replaced with "
		   TagString
	   )
    )
    (repeat i
      	(setq found nil blk (ssname TargetBlocks (setq i (1- i))))
	    (while
	        (and
	            (null found)
	            (setq blk (entnext blk))
	            (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))
	        )
		(entmod (subst (cons 1 TagString) (assoc 1 (reverse enx)) enx))
	        (entupd blk) (setq found TagString)
	                )
	            )
	        )
  (princ)
  )

HTH 

[braudpat]

Hello @pbejse 

THANKS AGAIN ! ... Your second routine is PERFECT !

THE HEALTH, Regards, Patrice