Jump to content

Recommended Posts

Posted

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?

Posted

Welcome to CADTutor .

 

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

Posted

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.

Posted

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

Posted (edited)

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.

Edited by marko_ribar
added : (setq p (trans p 0 1))
Posted

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

  • 1 month later...
Posted

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...