przem_saw Posted June 27, 2014 Posted June 27, 2014 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? Quote
Tharwat Posted June 27, 2014 Posted June 27, 2014 Welcome to CADTutor . Are you talking about rename a specific Block or replace a block with another in a drawing ? Quote
przem_saw Posted June 27, 2014 Author Posted June 27, 2014 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. Quote
Tharwat Posted June 27, 2014 Posted June 27, 2014 Is it a normal Block ? I mean not attributed nor even Dynamic Block . Quote
marko_ribar Posted June 27, 2014 Posted June 27, 2014 (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 June 28, 2014 by marko_ribar added : (setq p (trans p 0 1)) Quote
przem_saw Posted June 29, 2014 Author Posted June 29, 2014 marko_ribar Thank you, that's the program I was looking for! Quote
Guest Posted July 30, 2014 Posted July 30, 2014 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 Quote
przem_saw Posted July 31, 2014 Author Posted July 31, 2014 Try this http://www.lee-mac.com/copyblock.html Quote
Recommended Posts
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.