replace an insert

hello,
i am looking for a(exsisting?) lisp that will replace a selected insertion
with another block, retaining scale and orientation of the insert that has
to be "swapped". the definition of the original block must be unchanged,
because other inserts of that block have to remain unchanged, so a refedit
will not do what i want.

example:
i have a groundplan with 20 insertions of the block "door1" with various
insertion points and scales. 6 of those insertions i would like to change
into block "door2", one by one would be ok, selecting all six of them would
be great.

a sequence of commands i can imagine:
command: replaceblock.lsp
select the insert(s) to replace
get the insert's block orientation, insertion point, layer and color
erase the insert(s)
ask what new block insert to use
insert the chosen block with the old orientation, insertion point, color and
layer.

any help will be appriciated, marc

 

Here ya go.

Note that if either block definition contains attributes this will not
account for them. But it works great for all other blocks.

If the new name entered is not a valid block in the current drawing it will
search the Acad support path(s) to try to find it. If it's found then it is
placed in the drawing, if not then it exits and tells you that it couldn't
find the block.

Jeff

(defun c:repblk (/ ss name fname)
(vl-load-com)
(defun replace_block (ss newname / count blk)
(setq count -1)
(while (< (setq count (1+ count)) (sslength ss))
(setq blk (vlax-ename->vla-object (ssname ss count)))
(vla-put-name blk newname)
)
)
(if (or (setq ss (ssget "I" '((0 . "INSERT"))))
(setq ss (ssget '((0 . "INSERT"))))
)
(progn
(setq name (getstring "\nBlock name to replace selected blocks with:
"))
(cond ((tblsearch "block" name)(replace_block ss name))
((setq fname (findfile
(strcat name ".dwg")))(progn
(command "_.-insert" fname)
(command)
(command)
(replace_block ss name)
))
(t (princ "\New Block not found"))
)
)
)
(princ)
)

 

The code below will do that. Command "RB".
It issues a warning if there are attributes in either blocks.
You just have to pick a block of the type to be replaced (door1),
then a block of the new type (door2), then select objects within which
to perform the replacement (or select nothing to perform on everything).

Fab.

(defun C:RB (/ entiteold entitenew eoname enname jeusel1 i ent_actu
ent_data)
(setvar "cmdecho" 0)
(command "_.undo" "_begin")

(princ "automatically substitute blocks within a selection\n")
(setq EntiteOld (car (entsel "pick a block, the type which will be
replaced\n")))
(setq EntiteNew (car (entsel "pick a block of the new type\n")))

(setq EOname (cdr (assoc 2 (entget EntiteOld))))
(princ EOName)(princ " -> ")
(setq ENname (cdr (assoc 2 (entget EntiteNew))))
(princ ENName)

(if (/= (liste_att_ds_bloc EntiteOld) nil)
(alert "Warning, the replaced block contains attributes \n \n This
can give unexpected results \n \n Use ATTREDEF instead.")
)

(if (/= (liste_att_ds_bloc EntiteNew) nil)
(alert "Warning, the replacement block contains attributes \n \n
This can give unexpected results \n \n Use ATTREDEF instead.")
)

(princ "\n Select objects for which the replacement will be performed
[do an empty selection to perform on entire drawing] :")

(setq jeusel1 (ssget (list (cons 0 "INSERT") (cons 2 EOName))))

(if (= jeusel1 nil)
(setq jeusel1 (ssget "x" (list (cons 0 "INSERT") (cons 2 EOName))))
)

(setq i 0)
(repeat (sslength jeusel1)
(setq Ent_Actu (ssname jeusel1 i)
Ent_Data (entget Ent_Actu)
);setq
(setq i (1+ i))

(setq Ent_Data (subst (cons 2 ENname)(assoc 2 Ent_Data) Ent_Data ))
(entmod Ent_Data)

);repeat

(command "_.undo" "_end")
(setvar "cmdecho" 1)
(princ)

)

 

Here is a little code I had that will do this. It will also swap one attribute.

Peter Jamtgaard

;****************************RBLKS.LSP*******************************************
; Written By : Peter Jamtgaard
;.Purpose<RBLKS>: Replaces Selected BLOCKS with another picked BLOCK
;******************************************************************************
(defun rtd (a)(/ (* a 180.0) pi)) ;.radians to degrees z
(defun C:RBLKS () ;.REPLACE BLOCKS
(setvar "ATTDIA" 0)
(setq OLDATT nil)
(princ "\nSelect BLOCKS to be replaced: ")
(setq B 0 C 0)
;****************************************************************************
(setq SSET (ssget))
(if (= SSET nil)
(progn
(princ "\nNo entities were selected: ")
(setq B 1)
)
(progn
(setq NEWBLK (car (entsel "\nSelect block replacement: ")));new block name
(setq NEWLAYR (cdr (assoc 8 (entget NEWBLK)))) ;new lyr ent name
(setq NEWLT (cdr (assoc 6 (entget NEWBLK)))) ;new lt ent name
(setq NEWCLR (cdr (assoc 62 (entget NEWBLK)))) ;new clr ent name
(setq NEWTYPE (cdr (assoc 0 (entget NEWBLK)))) ;new ent type test
(if (= NEWTYPE "INSERT")
(setq B 0)
(progn
(princ "\nYour last selection was not a block: ")
(setq B 1)
)
)
)
)
;****************************************************************************
(while (= B 0)
(setq OLDENT (ssname SSET C));old BLOCK name
(if (= OLDENT nil)(setq B 1)
(progn
(setq OLDED (entget OLDENT))
(setq OLDTYPE (cdr (assoc 0 OLDED))) ;old ent type test
(if (/= OLDTYPE "INSERT")(setq SSET (ssdel OLDENT SSET))
(progn
(setq OLDBLK OLDENT)
(setq SCX (cdr (assoc 41 OLDED))) ;old blk insertion
(setq SCY (cdr (assoc 42 OLDED)))
(setq ROT (rtd (cdr (assoc 50 OLDED)))) ;old blk rotation
(setq INS (cdr (assoc 10 OLDED))) ;old blk insertion
(setq OLDTYPE (cdr (assoc 0 OLDED))) ;old ent type test
(setq REP (cdr (assoc 2 (entget NEWBLK)))) ;blk name replacement
(if (= (entnext OLDBLK) nil)(princ)
(if (= "ATTRIB" (cdr (assoc 0 (entget (entnext OLDBLK)))))
(progn
(setq OLDATT (cdr (assoc 1 (entget (entnext OLDBLK)))));Old Att. Value
(setq OLDATTANG (cdr (assoc 50 (entget (entnext OLDBLK)))));Old Att. Angle
(setq OLDATTWID (cdr (assoc 41 (entget (entnext OLDBLK)))));Old Att. Width
)
(princ "\nOld BLOCK didn't contain attributes: ")
)
)
(if (= "INSERT" OLDTYPE) ;test valid input
(progn
(command "INSERT" REP INS SCX SCY ROT);Insert NEWBLK over OLDBLK
(setq ENT (entlast))
(setq ED (entget ENT))
(setq ED (subst (cons 8 NEWLAYR) (assoc 8 ED) ED))
(if (= OLDATT nil)
(princ)
(progn
(setq NENT (entnext ENT))
(if (= NENT nil)(princ "\nLast Block has no attributes: ")
(progn
(setq NED (entget NENT))
(setq NENTTYPE (cdr (assoc 0 NED)))
(if (= NENTTYPE "ATTRIB")
(progn
(setq NED (subst (cons 1 OLDATT)(assoc 1 NED) NED))
(setq NED (subst (cons 50 OLDATTANG)(assoc 50 NED) NED))
(setq NED (subst (cons 41 OLDATTWID)(assoc 41 NED) NED))
(entmod NED)
)
(princ "\nNew Symbol doesn't contain Attributes: ")
)
)
)
)
)
(entmod ED)
(if (/= NEWLT nil)
(command "CHANGE" ENT "" "P" "LT" NEWLT "")
)
(if (/= NEWCLR nil)
(command "CHANGE" ENT "" "P" "C" NEWCLR "")
)
(setq C (+ C 1))
(princ "\nC+ ")
)
(progn
(princ "\nInvalid entity: ")
(setq B 1)
)
)
)
)
)
)
)
(command "erase" sset "")
(setvar "attdia" 1)
(prin1)
)

 

yo peter
just what i needed, thanx very much!
in time i will try to add some attrib stuff and more errorhandling,
thx to other repliers too, but this beats the others
much obliged, marc
"Peter Jamtgaard" <> schreef in bericht Here is a little code I had that will do this. It will also swap one attribute.

Peter Jamtgaard

;****************************RBLKS.LSP*******************************************
; Written By : Peter Jamtgaard
;.Purpose<RBLKS>: Replaces Selected BLOCKS with another picked BLOCK
;******************************************************************************
(defun rtd (a)(/ (* a 180.0) pi)) ;.radians to degrees z
(defun C:RBLKS () ;.REPLACE BLOCKS
(setvar "ATTDIA" 0)
(setq OLDATT nil)
(princ "\nSelect BLOCKS to be replaced: ")
(setq B 0 C 0)
;****************************************************************************
(setq SSET (ssget))
(if (= SSET nil)
(progn
(princ "\nNo entities were selected: ")
(setq B 1)
)
(progn
(setq NEWBLK (car (entsel "\nSelect block replacement: ")));new block name
(setq NEWLAYR (cdr (assoc 8 (entget NEWBLK)))) ;new lyr ent name
(setq NEWLT (cdr (assoc 6 (entget NEWBLK)))) ;new lt ent name
(setq NEWCLR (cdr (assoc 62 (entget NEWBLK)))) ;new clr ent name
(setq NEWTYPE (cdr (assoc 0 (entget NEWBLK)))) ;new ent type test
(if (= NEWTYPE "INSERT")
(setq B 0)
(progn
(princ "\nYour last selection was not a block: ")
(setq B 1)
)
)
)
)
;****************************************************************************
(while (= B 0)
(setq OLDENT (ssname SSET C));old BLOCK name
(if (= OLDENT nil)(setq B 1)
(progn
(setq OLDED (entget OLDENT))
(setq OLDTYPE (cdr (assoc 0 OLDED))) ;old ent type test
(if (/= OLDTYPE "INSERT")(setq SSET (ssdel OLDENT SSET))
(progn
(setq OLDBLK OLDENT)
(setq SCX (cdr (assoc 41 OLDED))) ;old blk insertion
(setq SCY (cdr (assoc 42 OLDED)))
(setq ROT (rtd (cdr (assoc 50 OLDED)))) ;old blk rotation
(setq INS (cdr (assoc 10 OLDED))) ;old blk insertion
(setq OLDTYPE (cdr (assoc 0 OLDED))) ;old ent type test
(setq REP (cdr (assoc 2 (entget NEWBLK)))) ;blk name replacement
(if (= (entnext OLDBLK) nil)(princ)
(if (= "ATTRIB" (cdr (assoc 0 (entget (entnext OLDBLK)))))
(progn
(setq OLDATT (cdr (assoc 1 (entget (entnext OLDBLK)))));Old Att. Value
(setq OLDATTANG (cdr (assoc 50 (entget (entnext OLDBLK)))));Old Att. Angle
(setq OLDATTWID (cdr (assoc 41 (entget (entnext OLDBLK)))));Old Att. Width
)
(princ "\nOld BLOCK didn't contain attributes: ")
)
)
(if (= "INSERT" OLDTYPE) ;test valid input
(progn
(command "INSERT" REP INS SCX SCY ROT);Insert NEWBLK over OLDBLK
(setq ENT (entlast))
(setq ED (entget ENT))
(setq ED (subst (cons 8 NEWLAYR) (assoc 8 ED) ED))
(if (= OLDATT nil)
(princ)
(progn
(setq NENT (entnext ENT))
(if (= NENT nil)(princ "\nLast Block has no attributes: ")
(progn
(setq NED (entget NENT))
(setq NENTTYPE (cdr (assoc 0 NED)))
(if (= NENTTYPE "ATTRIB")
(progn
(setq NED (subst (cons 1 OLDATT)(assoc 1 NED) NED))
(setq NED (subst (cons 50 OLDATTANG)(assoc 50 NED) NED))
(setq NED (subst (cons 41 OLDATTWID)(assoc 41 NED) NED))
(entmod NED)
)
(princ "\nNew Symbol doesn't contain Attributes: ")
)
)
)
)
)
(entmod ED)
(if (/= NEWLT nil)
(command "CHANGE" ENT "" "P" "LT" NEWLT "")
)
(if (/= NEWCLR nil)
(command "CHANGE" ENT "" "P" "C" NEWCLR "")
)
(setq C (+ C 1))
(princ "\nC+ ")
)
(progn
(princ "\nInvalid entity: ")
(setq B 1)
)
)
)
)
)
)
)
(command "erase" sset "")
(setvar "attdia" 1)
(prin1)
)