Using a lisp routine, how can I take everything in a drawing off of layer 0 (including everything inside blocks), and put it on a new layer ARCH 0? I have been trying to edit the associate list, but with no luck.
Thanks, TJ
Using a lisp routine, how can I take everything in a drawing off of layer 0 (including everything inside blocks), and put it on a new layer ARCH 0? I have been trying to edit the associate list, but with no luck.
Thanks, TJ
You have to cycle through every entity, and change the group 8 code to suit your layer, and then ENTMOD.
Show us what you have so far.
I use filter type FI at command line and select everything on the layer then change to new layer. For blocks select them and change to new layer.
He wants a LISP solution.
Here is a LISP routine (I can't remember who wrote the original one)... but it changes blocks to LAYER Zero (0).
Just change that line: ;Changes layer to 0 (setq Edata(subst (cons 8 "0")(assoc 8 Edata)Edata))
.... from CONS 8 "0" to Cons 8 "yourlayername"... and it should work.
WHATCH OUT FOR LINE WRAP...
; Block0.LSP redefines all objects in a block on layer 0, with color and linetype ; set to BYLAYER. Changed blocks will then take on the properties of the layer ; that they are inserted on. The routine works by modifing objects in the block table, ; so the blocks never have to be exploded. ; ; The global method redefines ALL objects in every block in the current drawing, ; except dimensions, hatching or xrefs, even if they are on a layer that is ; frozen or turned off. ; ; The select method redefines blocks selected with any standard selection method, ; as well as any blocks nested in the selected block(s).
(defun To-0( Blck / Bname Blist E Edata Spinn Tmp )
;Prints a pinwheel on the command line (defun Spinn ( ) (setq SYM (cond ((= SYM nil) "-") ((= SYM "-") "\\") ((= SYM "\\") "|") ((= SYM "|") "/") ((= SYM "/") "-") ) ) (princ (strcat "\rScanning... " SYM "")) );end Spinn
(if (=(type Blck)(read "LIST"))(setq Tmp(car Blck) Blist(cdr Blck) Blck Tmp Tmp nil)) (setq Blck (tblsearch "BLOCK" Blck)) (if (and (/=(logand(cdr(assoc 70 Blck))1)1) ;skips annomyous blocks (/= (logand(cdr(assoc 70 Blck))4)4) ;skips xrefs );and (progn (setq E (cdr (assoc -2 Blck))) (while E ;If the object is a block (if (=(cdr(assoc 0 (entget E))) "INSERT") (progn ;save the name to a list (setq Bname(cdr(assoc 2(entget E)))) (if (not (member Bname Blist)) ;create the list if it doesn't exist (if (not Blist)(setq Blist (list Bname)) (setq Blist(append Blist(list Bname))) );if );if );progn );if (setq Edata (entget E)) ;Resets object color to BYLAYER if it isn't (if(assoc 62 Edata) (setq Edata(subst(cons 62 256)(assoc 62 Edata)Edata)) );if ;Resets object linetype to BYLAYER if it isn't (if(assoc 6 Edata) (setq Edata(subst(cons 6 "BYLAYER")(assoc 6 Edata)Edata)) );if ;Changes layer to 0 (setq Edata(subst (cons 8 "0")(assoc 8 Edata)Edata)) ;updates entity (entmod Edata) ;get next enitiy, nil if end of block (setq E (entnext E)) (Spinn) );end while E );progn );if Blist ;returns names of any nested blocks );defun
; ================================================================= ; Main program (defun c:Block0( / Blk_nm Choice E Edata Idx Pk_Blk SS ) (command "._undo" "m") (setq Choice "S") (initget "A S")
(setq Choice(getkword (strcat "\nll Blocks or elected Blocks: "))) (if(not Choice)(setq Choice "S")) (if (= (strcase Choice) "A")
;All Blocks (while (setq Blk_nm(tblnext "BLOCK" (null Blk_nm))) (TO-0 (cdr(assoc 2 Blk_nm))) );while
;Selected Block (progn (prompt "\nSelect Block(s) to Clean Up: ") (setq SS(ssget '((0 . "INSERT")))) (setq Idx 0)
(repeat (sslength SS) (setq Blk (cdr(assoc 2 (entget(ssname SS Idx))))) (cond (Pk_Blk (setq Pk_Blk(append Pk_Blk (list Blk)))) (T (setq Pk_Blk(list Blk))) );cond (setq Idx(1+ Idx)) );repeat
(while Pk_Blk (setq Pk_Blk(To-0 Pk_Blk)) );while
);progn );if
(command "._regen") ; (princ "\rFinished ") (princ) );defun
(princ)
Here buddy, I call it Lay2lay.
1: Create entity on wanted layer, if there is none already 2: Pick object on layer you want to change (in your case:0) then pick the entity you created in step 1 3: Lather, rinse, repeat.(DEFUN c:lay2lay (/ pick pick2 startlay endlay stuff cnt each) ;; Selection de la couche de départ et de destination (SETQ pick (ENTSEL "\n Pick object on starting layer...")) ;; L'objet choisi se met en surbrillance (REDRAW (CAR pick) 3) (SETQ pick2 (ENTSEL (strcat "\n( "(cdr (assoc 8 (entget (car pick))))" ) Pick object on destination layer...") ) ) (SETQ startlay (CDR (ASSOC 8 (CDR (ENTGET (CAR pick)))))) ; Name of start layer (SETQ endlay (CDR (ASSOC 8 (CDR (ENTGET (CAR pick2)))))) ; Name of destination layer (CONS 8 (EVAL startlay)) (SETQ stuff (SSGET "X" (LIST (CONS 8 (EVAL startlay))))) (SETQ cnt 0) (REPEAT (SSLENGTH stuff) (SETQ each (ENTGET (SSNAME stuff cnt))) (SETQ each (SUBST (CONS 8 endlay) (ASSOC 8 each) ; Changes the layer group in STARTLAY each ; to layer ENDLAY. ) ) (ENTMOD each) (SETQ cnt (+ cnt 1)) ) ;_end REPEAT (command "_.regen") (PRINC (STRCAT "\n ---> " (ITOA cnt) " objects have changed layers.") ) (PRINC) )
Cheers Dr Fleau
a écrit dans le message de news: snipped-for-privacy@73g2000cwn.googlegroups.com...
I admit I never tried to change a block with attributes with this routine. Let me know how it works.
Dr Fleau
a écrit dans le message de news: snipped-for-privacy@73g2000cwn.googlegroups.com...
PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.