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
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.