First Insert all block from the drawing database using one insertion point..
Code by Lee Mc Donell from Cadtutor
Code:
(DEFUN C:BLKINS (/ blks pt name)
(vl-load-com)
(setq *acad* (vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq *ms* (vla-get-ModelSpace *acad*))
(if (and (not (zerop (- (vla-get-count (setq blks (vla-get-blocks *acad*))) 1 (length (layoutlist)))))
(setq pt (getpoint "\nSelect Point for Block: ")))
(vlax-for item blks
(if (not (eq "*" (substr (setq name (vla-get-Name item)) 1 1)))
(vlax-invoke-method *ms* 'InsertBlock (vlax-3d-point pt) name 1.0 1.0 1.0 0.0))))
(princ))
Then change all their properties to Layer 0, also this lisp will change their properties
Color, linetype and lineweight to Bylayer... If you don't want those properties changed... just delete these three lines (at the end of the routine)
Code:
(vla-put-color ent 256)
(vla-put-lineweight ent aclnwtbylayer)
(vla-put-linetype ent "bylayer")
Code:
;Made by ;kpblc in Cadtutor.com
;http://www.cadtutor.net/forum/showthread.php?t=19161
;fixall will change selected blocks in current drawing
;to layer 0, color, linetype & lineweight bylayer
(defun c:BL0 (/ *error* adoc lst_layer func_restore-layers)
(princ " Select blocks to redefine to layer 0, color and linetype Bylayer:")
(defun *error* (msg)
(func_restore-layers)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(defun func_restore-layers ()
(foreach item lst_layer
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vl-catch-all-apply
'(lambda ()
(vla-put-freeze
(car item)
(cdr (assoc "freeze" (cdr item)))
) ;_ end of vla-put-freeze
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of foreach
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(if (and (not (vl-catch-all-error-p
(setq selset
(vl-catch-all-apply
(function
(lambda ()
(ssget '((0 . "INSERT")))
) ;_ end of lambda
) ;_ end of function
) ;_ end of vl-catch-all-apply
) ;_ end of setq
) ;_ end of vl-catch-all-error-p
) ;_ end of not
selset
) ;_ end of and
(progn
(vlax-for item (vla-get-layers adoc)
(setq
lst_layer (cons (list item
(cons "lock" (vla-get-lock item))
(cons "freeze" (vla-get-freeze item))
) ;_ end of list
lst_layer
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(vl-catch-all-apply
'(lambda () (vla-put-freeze item :vlax-false))
) ;_ end of vl-catch-all-apply
) ;_ end of vlax-for
(foreach blk_def
(mapcar
(function
(lambda (x)
(vla-item (vla-get-blocks adoc) x)
) ;_ end of lambda
) ;_ end of function
((lambda (/ res)
(foreach item (mapcar
(function
(lambda (x)
(vla-get-name
(vlax-ename->vla-object x)
) ;_ end of vla-get-name
) ;_ end of lambda
) ;_ end of function
((lambda (/ tab item)
(repeat (setq tab nil
item (sslength selset)
) ;_ end setq
(setq
tab
(cons
(ssname selset
(setq item (1- item))
) ;_ end of ssname
tab
) ;_ end of cons
) ;_ end of setq
) ;_ end of repeat
tab
) ;_ end of lambda
)
) ;_ end of mapcar
(if (not (member item res))
(setq res (cons item res))
) ;_ end of if
) ;_ end of foreach
(reverse res)
) ;_ end of lambda
)
) ;_ end of mapcar
(vlax-for ent blk_def
(vla-put-layer ent "0")
(vla-put-color ent 256)
(vla-put-lineweight ent aclnwtbylayer)
(vla-put-linetype ent "bylayer")
) ;_ end of vlax-for
) ;_ end of foreach
(func_restore-layers)
(vla-regen adoc acallviewports)
) ;_ end of progn
) ;_ end of if
(vla-endundomark adoc)
(princ)
) ;_ end of defun
---------
***************
Or simply use this lisp..
will change automatically all blocks in the current drawing to Layer 0 (without inserting them or anything), other properties will remain.
Code:
;;; File Name: Layerfix.LSP
;;; Description: Changes the block definitions to Layer 0, Other properties will remain . Will skip all
;;; XREF & XREF dependent blocks.
;;;
;;; Global Variables: None
;;;
;;; Local Variables: Self-explanatory
;;;
;;; Program Arguments: None
;;; Subroutines/Functions Defined or Called: None
;;;
;;;***************************************************************************
(defun C:BL03 (/ BLKDATA NEWCOLOR NEWCOLOR NEWLAYER LAYER XREFFLAG XDEPFLAG BLKENTNAME
COUNT ENTDATA ENTNAME ENTTYPE OLDCOLOR OLDLAYER SSCOUNT SS)
(command ".undo" "group")
(setq BLKDATA (tblnext "BLOCK" t))
(setq NEWCOLOR (cons 62 256)) ;this will set 62 (color) to bylayer
(setq NEWLAYER (cons 8 "0")) ;this will set 8 (layer) to 0
; While there is an entry in the block table to process, continue
(while BLKDATA
(prompt "\nRedefining colors for block: ")
(princ (cdr (assoc 2 BLKDATA)))
; Check to see if block is an XREF or is XREF dependent
(setq XREFFLAG (assoc 1 BLKDATA))
(setq XDEPFLAG (cdr (assoc 70 BLKDATA)))
; If block is not XREF or XREF dependent, i.e., regular block, then proceed.
(if (and (not XREFFLAG) (/= (logand XDEPFLAG 32) 32))
(progn
(setq BLKENTNAME (cdr (assoc -2 BLKDATA)))
(setq COUNT 1)
(terpri)
; As long as we haven't reached the end of the block's defintion, get the data
; for each entity and change its color assignment to BYLAYER.
(while BLKENTNAME
(princ COUNT)
(princ "\r")
(setq ENTDATA (entget BLKENTNAME)); get entities data
(setq OLDCOLOR (assoc 62 ENTDATA)) ;get entities old color value
(setq OLDLAYER (assoc 8 ENTDATA)) ;get entities old layer value
(if OLDCOLOR ; if value exist (null = bylayer)
(entmod (subst NEWCOLOR oldcolor ENTDATA)) ; substitute old color to byblock
(entmod (cons NEWCOLOR ENTDATA)) ; modify ent data w/ byblock values
)
(if OLDLAYER ; if value exist (null = bylayer)
(entmod (subst newlayer oldlayer ENTDATA)) ; substitute old color to byblock
(entmod (cons newlayer ENTDATA)) ; modify ent data w/ byblock values
)
(setq BLKENTNAME (entnext BLKENTNAME)) ;if attributes exist, then edit next one
(setq COUNT (+ COUNT 1));
) ;end while for attribute trap
) ;progn
(progn
(princ " XREF...skipping!")
) ;progn
);end if not an Xref
(setq BLKDATA (tblnext "BLOCK")) ;next block please
) ;end while loop of blk data available to edit
(command ".undo" "end")
(command ".regen")
(PROMPT "\nDone... ")
(princ)
)
And one of the best options is here, from Gilles Chanteau, it will allow you to select all possible options for several properties to redefine all your blocks within the current drawing, without exploding, inserting or anything. this one is attached.
Re: Convert MANY blocks to Layer0
Originally Posted by jontramos
Reply With Quote
