Block SUBSTITUTE name lisp

Hi Everyone, basically I need to change a name of one block using a lisp routine.

I found this:

(defun c:REP (/ ENT1 BL1 bl2 OLD ODNM)
(command "undo" "begin")
(prompt "\nSelect Replacement Block: ")
(setq bl2 (cdr (assoc 2 (entget (car (entsel))))))
(prompt "Select blocks to replace: ")
(setq ENT1 (ssget))
(setq N (sslength ENT1))
(setq I 0)
(repeat N
 (setq BL1 (entget (ssname ENT1 I)))
 (setq NWNM (cons 2 bl2))  
 (setq OLD (assoc 2 BL1))  
 (setq ODNM (cdr OLD))  
 (entmod (subst NWNM OLD BL1))
 (setq I (1+ I))
)
(command "undo" "end")
(princ)
) 

and tryed change to this:

(defun c:REPT (/ ENT1 BL1 bl2 OLD ODNM)
(command "undo" "begin")
(setq bl2 (getstring "\nType a new name: "))
(prompt "Select blocks to replace: ")
(setq ENT1 (ssget))
(setq N (sslength ENT1))
(setq I 0)
(repeat N
 (setq BL1 (entget (ssname ENT1 I)))
 (setq NWNM (cons 2 bl2))  
 (setq OLD (assoc 2 BL1))  
 (setq ODNM (cdr OLD))  
 (entmod (subst NWNM OLD BL1))  (princ NWNM) (princ old)
 (setq I (1+ I))
)
(command "undo" "end")
(princ)
) 

but second routine doesn't work.

Anyone know why?

Welcome to CADTutor .

Are you talking about rename a specific Block or replace a block with another in a drawing ?

I have let's say 10 blocks in drawing named Shape1 (they are the same of course) and I want to change name of one to Shape2 so I will have 9 blocks named Shape1 and 1 block Shape2 and they still look the same.

Is it a normal Block ? I mean not attributed nor even Dynamic Block .

If unique block references, try this code...

(defun c:renblref ( / ss n k bl blnl p )

 (vl-load-com)

 (setq n "")
 (while (not (snvalid n))
   (setq n (getstring t "\nSpecify new block reference name: "))
 )
 (prompt "\nSelect block references to rename")
 (setq ss (ssget ":L" '((0 . "INSERT"))))
 (setq k -1)
 (while (setq bl (ssname ss (setq k (1+ k))))
   (setq blnl (cons (vl-remove-if-not '(lambda ( x ) (member (car x) '(8 2 41 42 43 50 210))) (entget bl)) blnl))
 )
 (if (not (vl-every '(lambda (x) (equal x (car blnl))) blnl))
   (progn
     (alert "Selected block references with different layers, or names, or scale factors, or rotations, or normals - quitting... Select only unique block references...")
     (exit)
   )
   (progn
     (setq k -1)
     (while (setq bl (ssname ss (setq k (1+ k))))
       (setq p (cdr (assoc 10 (entget bl))))
       (setq p (trans p 0 1))
       (if (eq k 0)
         (progn
           (command "_.explode" bl)
           (while (> (getvar 'cmdactive) 0) (command ""))
           (command "_.copybase" p (ssget "_P") "")
           (command "_.pasteblock" p)
           (command "_.erase" (ssget "_P") "")
           (vla-put-name
             (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                       )
                       (vla-get-name (vlax-ename->vla-object (entlast)))
             )
             n
           )
           (vla-auditinfo
             (vla-get-activedocument (vlax-get-acad-object))
             :vlax-true
           )
           (vla-put-name
             (vla-item (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                       )
                       (vla-get-name (vlax-ename->vla-object (entlast)))
             )
             n
           )
         )
         (progn
           (command "_.erase" bl "")
           (command "_.insert" n p 1 1 0)
         )
       )
     )
   )
 )
 (princ)
)

HTH, M.R.

marko_ribar Thank you, that's the program I was looking for!

Nice job marko_ribar .Is it posible this lisp to work with block attribiuts. Now works but delete all the tags inside .

Thanks

Point.dwg

Try this http://www.lee-mac.com/copyblock.html