On 5 Dec 2006 10:47:17 -0800, in alt.cad.autocad you wrote:
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 "\n<A>ll Blocks or <S>elected Blocks: <"
Choice "> ")))
(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)
Polytechforum.com is a website by engineers for engineers. It is not affiliated with any of manufacturers or vendors discussed here.
All logos and trade names are the property of their respective owners.