BlockReplace - Keep attributes

[mruu]

I've been using the block replace from here. Quick question:

 

...
(vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
				(setq temp (vla-copy blk))
				(mapcar (function (lambda (p)
					(vl-catch-all-apply
					(function vlax-put-property)
					(list temp p (vlax-get-property x p))
					)
					)
					)
					'(Insertionpoint Rotation)				;something like "Attributes" or "REF" in here..??									
				)
				(vla-delete x)
)
...

 

If I wanted to keep the attributes of the original blocks (as well as their "InsertionPoint" & "Rotation"), is there a word like "Attributes" or something i can slide in to do so?

Cheers.

 

[Aftertouch]

This is the code that i use.

 

;; [oldblk]   = old block entity name
;; [newblk]   = new block name
;; [blkloc]   = block location list of x y z
;; [blklayer] = string of layername
(defun HB:BLOCKREPLACE (oldblk newblk blkloc blklayer / )
    (command "-INSERT" newblk blkloc "" "" "")
    (vlax-put-property (vlax-ename->vla-object (entlast)) 'Layer blklayer)
    (LM:setattributevalues (entlast) (LM:getattributevalues oldblk))
    (vla-erase (vlax-ename->vla-object oldblk))
)

 

Code profided by LeeMac:

;; blk - [ent] Block (Insert) Entity Name
;; Returns: [lst] Association list of ((<tag> . <value>) ... )
(defun LM:getattributevalues ( blk / enx )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (cons
            (cons
                (cdr (assoc 2 enx))
                (cdr (assoc 1 (reverse enx)))
            )
            (LM:getattributevalues blk)
        )
    )
)

 

Code profided by LeeMac:

;; blk - [ent] Block (Insert) Entity Name
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:setattributevalues ( blk lst / enx itm )
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (if (setq itm (assoc (cdr (assoc 2 enx)) lst))
            (progn
                (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 (reverse enx)) enx))
                    (entupd blk)
                )
                (LM:setattributevalues blk lst)
            )
            (LM:setattributevalues blk lst)
        )
    )
)

Edited January 10, 2020 by Aftertouch

[ronjonp]

Try something like this .. no error checking.

(defun _matchatts (b1 b2 / a)
  (setq a (vlax-vla-object->ename b2))
  (foreach x (vlax-invoke b1 'getattributes)
    (setpropertyvalue a (vla-get-tagstring x) (vla-get-textstring x))
  )
)
(vlax-for x (setq ss (vla-get-activeselectionset *acaddoc*))
  (setq temp (vla-copy blk))
  (mapcar (function
	    (lambda (p)
	      (vl-catch-all-apply (function vlax-put-property) (list temp p (vlax-get-property x p)))
	    )
	  )
	  '(insertionpoint rotation)	;something like "Attributes" or "REF" in here..??									
  )
  (_matchatts x temp)
  (vla-delete x)
)

 

[mruu]

Thanks for that guys, appreciate the input.

Aftertouch, your code doesn't allow old & new block names to be equal. That is a problem for me. 

Ronjonp, your code works perfectly. If I ever want to go back to replacing the old with new attributes I can simply deactivate the "(_matchatts x temp)" line as well which is handy.

 

Thanks so much!!

[ronjonp]

12 hours ago, mruu said:

Thanks for that guys, appreciate the input.

Aftertouch, your code doesn't allow old & new block names to be equal. That is a problem for me. 

Ronjonp, your code works perfectly. If I ever want to go back to replacing the old with new attributes I can simply deactivate the "(_matchatts x temp)" line as well which is handy.

 

Thanks so much!!

You're welcome!