TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: hudster on April 27, 2004, 07:50:32 AM
-
I'm trying to write a lisp that will get a list of the blocks in a drawing and re-define them using the standard blocks we use in our office.
I have this piece of code.
(defun c:REDEF ()
(setq ss (ssget "_X" '((0 . "INSERT"))))
(command "-insert" "SS=C:/RYBKA_BLOCKS/BLOCKS/" SS)
(command)
(PRINC)
)
but it down't work, it gets the list, but how do i get it to redefine each block on the list?
-
http://theswamp.org/phpBB2/viewtopic.php?t=977&highlight=insert+replace
http://theswamp.org/phpBB2/viewtopic.php?t=299&highlight=insert+replace
-
I had already looked both those threads, but they don't quite do what I want them to.
This piece of code
(command "-insert" "titleblock=c:/blks/titleblocks/titleblock")(command)
is almost there, but how do i substitute the "titleblock= " part of it so it uses the block list obtained by the (setq ss (ssget "_X" '((0 . "INSERT"))))
-
Something like this.. untested..
(defun c:REDEF ()
(setq ss (ssget "_X" '((0 . "INSERT"))))
(setq idx (sslength ss))
(while (>= (setq idx (1- idx)) 0)
(setq blknm (ssname ss idx))
(command "-insert" (strcat blknm "=C:/RYBKA_BLOCKS/BLOCKS/" blknm))
(command)
)
(PRINC)
)
-
When I run this I get the following message.
Command: REDEF ; error: bad argument type: stringp <Entity name: 7e830f60>
Enter block name or [?] <A$C6F405EDD>:
-
Sorry about that... routine needed the acutal block name
(defun c:REDEF ()
(setq ss (ssget "_X" '((0 . "INSERT"))))
(setq idx (sslength ss))
(while (>= (setq idx (1- idx)) 0)
(setq blknm (cdr (assoc 2 (entget(ssname ss idx)))))
(command "-insert" (strcat blknm "=C:/RYBKA_BLOCKS/BLOCKS/" blknm))
(command)
)
(PRINC)
)
-
Brilliant.
your definately THE DADDY.
-
Glad it worked for you, it's quick and dirty.
Not sure how it would do with x-ref's, it may choke.
Be aware that if the block is not found you don't get any warning.
CAB
I take that back, you get a message at the command line if it fails
to replace the block or if it is an x-ref.
-
Here are some more elaborate routines.
I have not tried them.
(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 (strcat "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 (strcat "Warning, the replacement block contains attributes "
"\n \n This can give unexpected results"
"\n \n Use ATTREDEF instead.")
)
)
(princ (strcat"\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)
)