Hi
I have a lot of block that consist hundred block in block in block, in some specyfic layer and they are colored (not by layer).
It is killing me go inside every block and change, by 0, color by layer. Is it possible to ask about that lisp?
What I need is simpely all in 0, even it is block in block in block.
I have tryed lisp from here, but it does not menat to change color-by layer, and does not go deep inside block in block.
I someone who can help me?
Jo
Solved! Go to Solution.
Solved by Kent1Cooper. Go to Solution.
Solved by Lee_Mac. Go to Solution.
@Anonymous wrote:
....
I have a lot of block that consist hundred block in block in block, in some specyfic layer and they are colored (not by layer).
It is killing me go inside every block and change, by 0, color by layer. Is it possible to ask about that lisp?
What I need is simpely all in 0, even it is block in block in block.
....
Here's one way to do it -- a quick modification of something I already had that only changed everything's color to Bylayer; I added in the changing of everything's Layer to 0. It will do it to just things in Block definitions, but if you want to do everything in the drawing, un-comment-out the red parts [and presumably change the file and command names] -- those parts are there because the other routine was to do everything in the drawing. It could also be adjusted easily to change linetypes and other properties to ByLayer or other default values [thickness to 0, linetype scale to 1, etc.].
;; BlockParts0Bylayer.lsp [command name: BP0B]; [that's a number 0, not a capital letter O]
;; To change all entities in all Block definitions in the drawing, including
;; all nested Block definitions [but not Xrefs] and Dimension/Leader
;; parts, to Layer 0 & color ByLayer.
;; Kent Cooper, 3 November 2014
(vl-load-com)
(defun C:BP0B ; = Block Parts to Layer 0 and color Bylayer
(/ l0cb ent obj blk subent)
(defun l0cb () ; = force Color(s) to Bylayer
(setq obj (vlax-ename->vla-object ent))
(vla-put-layer obj "0"); to Layer 0
(vla-put-color obj 256); color ByLayer
(if (wcmatch (vla-get-ObjectName obj) "*Dimension,*Leader")
(foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
;; not all such entity types have all 3 properties, but all have at least one
(if (vlax-property-available-p obj prop)
(vlax-put obj prop 256); ByLayer
); if
); foreach
); if
); defun -- l0cb
;; Top-level entities:
; (setq ent (entnext))
; (while ent
; (l0cb)
; (setq ent (entnext ent))
; ); while
;; Nested entities in this drawing's Block definitions:
(setq blk (tblnext "block" t))
(while blk
(if (= (logand 20 (cdr (assoc 70 blk))) 0); not an Xref [4] or Xref-dependent [16]
(progn
(setq ent (cdr (assoc -2 blk)))
(while ent
(l0cb)
(setq ent (entnext ent))
); while
); progn
); if
(setq blk (tblnext "block"))
); while
(command "_.regenall")
(princ)
); defun
The following will modify all objects within the block definitions of selected blocks (including all nested blocks, nested to any depth) and should also be compatible with AutoCAD for Mac:
(defun c:blkto0 ( / idx lst sel ) (if (setq sel (ssget '((0 . "INSERT")))) (repeat (setq idx (sslength sel)) (block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx))))))) ) ) (command "_.regen") (princ) ) (defun block->0 ( blk / ent enx ) (cond ( (member blk lst)) ( (setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (entmod (subst-append 8 "0" (subst-append 62 256 (setq enx (entget ent))))) (if (= "INSERT" (cdr (assoc 0 enx))) (block->0 (cdr (assoc 2 enx))) ) ) (setq lst (cons blk lst)) ) ) ) (defun subst-append ( key val lst / itm ) (if (setq itm (assoc key lst)) (subst (cons key val) itm lst) (append lst (list (cons key val))) ) )
You're welcome!
Lee
@Anonymous wrote:
short check showed that is almost perfect, thank you a lot Kent! Is that possible that I can klick on block that I would like to chosse for use command?
Lee's is shorter, but since I had the parts to combine [from the routine above and one in a link in the thread you posted a link to, if that's not too confusing...], here's a modification to allow selection of Blocks. It does the same to any Blocks that are nested in the definitions of selected ones, so if any of those are also Inserted in the drawing outside of their parent Blocks, those will also be affected even if you didn't select one. It has a different file name, with an S in it for Selected Blocks rather than all Block definitions, but it uses the same command name -- change that if you use it and also use the other one. It leaves things on the Defpoints Layer alone, just because that was part of the routine I took some of it from. Lightly tested, without setting up all possible detailed circumstances.
;; BlockSParts0Bylayer.lsp
;; = change all Parts of definitions of Selected Block(s) [other
;; than on Layer Defpoints] to Layer 0 with Color ByLayer
;; Kent Cooper, 3 November 2014
(vl-load-com)
(defun C:BP0B (/ nametolist blkss inc blk blknames ent edata obj)
(defun nametolist (blk / blkobj blkname); get Block name and put it into list of names
(if (= (logand (cdr (assoc 70 (entget blk))) 4) 0) ; not an Xref
(progn
(setq
blkobj (vlax-ename->vla-object blk)
blkname
(vlax-get-property blkobj
(if (vlax-property-available-p blkobj 'EffectiveName) 'EffectiveName 'Name)
; to work with older versions that don't have dynamic Blocks
); ...get-property & blkname
); setq
(if
(not (member blkname blknames)); name not already in list
(setq blknames (append blknames (list blkname))); then -- add to end of list
); if
); progn
); if
); defun -- nametolist
(setq blkss (ssget '((0 . "INSERT")))); User selection of any number of Blocks/Minserts/Xrefs
(repeat (setq inc (sslength blkss)); get names from initial selection
(setq blk (ssname blkss (setq inc (1- inc))))
(nametolist blk)
); repeat
(while (setq blk (car blknames)); as long as there's another Block name in list
;; [done this way instead of via (repeat) or (foreach), so it can add nested Blocks' names to the list]
(setq ent (tblobjname "block" blk)); Block definition as entity
(while (setq ent (entnext ent)); then -- proceed through sub-entities in definition
(setq edata (entget ent))
(if (member '(0 . "INSERT") edata) (nametolist ent)); if nested Block, add name to end of list
(if (not (member '(8 . "Defpoints") edata)); process all entities NOT on Layer Defpoints
(progn
(setq obj (vlax-ename->vla-object ent))
(vla-put-layer obj "0"); to Layer 0
(vla-put-color obj 256); color ByLayer
(if (wcmatch (vla-get-ObjectName obj) "*Dimension,*Leader")
(foreach prop '(DimensionLineColor ExtensionLineColor TextColor)
;; not all such entity types have all 3 properties, but all have at least one
(if (vlax-property-available-p obj prop)
(vlax-put obj prop 256); ByLayer
); if
); foreach
); if
); progn
); if
); while -- sub-entities
(setq blknames (cdr blknames)); take first one off
); while
(command "_.regen")
(princ)
); defun
Just be careful not to miss the selection when prompted, as Kent's code will error
@Lee_Mac wrote:
Just be careful not to miss the selection when prompted, as Kent's code will error
True -- I do sometimes do bare-bones versions without some of the usual controls, and after finding out whether they do what's wanted, other refinements can be added. Here's the same thing with ensurance of a viable selection, as well as Undo begin/end wrapping.
@Lee_Mac wrote:The following will modify all objects within the block definitions of selected blocks (including all nested blocks, nested to any depth) and should also be compatible with AutoCAD for Mac:
(defun c:blkto0 ( / idx lst sel ) (if (setq sel (ssget '((0 . "INSERT")))) (repeat (setq idx (sslength sel)) (block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx))))))) ) ) (command "_.regen") (princ) ) (defun block->0 ( blk / ent enx ) (cond ( (member blk lst)) ( (setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (entmod (subst-append 8 "0" (subst-append 62 256 (setq enx (entget ent))))) (if (= "INSERT" (cdr (assoc 0 enx))) (block->0 (cdr (assoc 2 enx))) ) ) (setq lst (cons blk lst)) ) ) ) (defun subst-append ( key val lst / itm ) (if (setq itm (assoc key lst)) (subst (cons key val) itm lst) (append lst (list (cons key val))) ) )
Hi Lee-Mac, can you edit for me. I can't convert layer for block in block. Thanks!
Hi friend,
I have a code lisp, it can change layer in block but cann't change layer for "block in block". Can you help me fix my code lisp. Thanks !
Try this code, test it. It is implemented the other way around. Yours is subroutine inside of Lee's.
Lee, hope you don't mind.
;Modified by BeekeeCZ ;Original by Lee Mac ;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-all-to-0-layer-by-layer-including-block-and-block-in/td-p/5376995/page/2 (defun c:CBV (/ block->0 subst-append subst-append-06 idx lst sel ) (defun block->0 (blk / ent enx) (cond ((member blk lst)) ((setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (entmod (subst-append 8 "0" (subst-append 62 256 (subst-append-06 6 (setq enx (entget ent)))))) (if (= "INSERT" (cdr (assoc 0 enx))) (block->0 (cdr (assoc 2 enx)))) ) (setq lst (cons blk lst)) ) ) ) (defun subst-append (key val lst / itm) (if (setq itm (assoc key lst)) (subst (cons key val) itm lst) (append lst (list (cons key val))) ) ) (defun subst-append-06 (key lst / itm str) (if (setq itm (assoc key lst)) (progn (setq str (strcase (cdr itm)) val (cond ((wcmatch str "CONTIN*S") "ByBlock") ((wcmatch str "CENTER2,BORDER*,DASHDOT*,DIVIDE,ACAD_ISO0[45689]W100,ACAD_ISO1[012345]W100,JIS_08_11,JIS_08_15,JIS_08_25,JIS_08_37,JIS_08_50,JIS_09_08,JIS_09_15,JIS_09_29,JIS_09_50,DOTTED_DASHED7") "CENTER") ((wcmatch str "DASHED,DOT,HIDDEN*,ACAD_ISO0[237]W100,JIS_02_0.7,JIS_02_1.0,JIS_02_1.2,JIS_02_2.0,JIS_02_4.0,SHORT_DASHED[56]") "DASHED2") ((cdr itm)))) (subst (cons key val) itm lst)) (append lst (list (cons key "ByBlock"))) ) ) (if (setq sel (ssget '((0 . "INSERT")))) (repeat (setq idx (sslength sel)) (block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx))))))))) (command "_.regen") (princ) )
Thank you!
I'm so happy when received your reply. Your lisp work perfect as well. How can I change color of DASHED 2, CENTER, CENTER2, PHANTOM2 into color 9.
Thanks again guys.
@Anonymous wrote:... How can I change color of DASHED 2, CENTER, CENTER2, PHANTOM2 into color 9.
You should do a similar subroutine as I did. Condition for key 6, but substitute pair with key 62.
But make up your mind and figure out want you really want and all of it! Because CENTER2 is changing to CENTER... Change a color of DASHED2 before or after are plenty of other linetypes changed to DASHED2?
My friend, I've tried entering as your direction.
Slightly tested.
;Modified by BeekeeCZ ;Original by Lee Mac ;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-all-to-0-layer-by-layer-including-block-and-block-in/td-p/5376995/page/2 (defun c:CBV (/ block->0 subst-append subst-append-06 subst-append-62 idx lst sel ) (defun block->0 (blk / ent enx) (cond ((member blk lst)) ((setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (entmod (subst-append 8 "0" (subst-append-62 62 (subst-append 62 256 (subst-append-06 6 (setq enx (entget ent))))))) (if (= "INSERT" (cdr (assoc 0 enx))) (block->0 (cdr (assoc 2 enx)))) ) (setq lst (cons blk lst)) ) ) ) (defun subst-append (key val lst / itm) (if (setq itm (assoc key lst)) (subst (cons key val) itm lst) (append lst (list (cons key val))) ) ) (defun subst-append-62 (key lst / itm str val) (if (setq itm (assoc 6 lst)) (progn (setq str (strcase (cdr itm)) val (cond ((wcmatch str "CENTER,DASHED2,PHANTOM2") 9) ((cdr itm)))) (subst (cons key val) (assoc key lst) lst)) ) ) (defun subst-append-06 (key lst / itm str val) (if (setq itm (assoc key lst)) (progn (setq str (strcase (cdr itm)) val (cond ((wcmatch str "CONTIN*S") "ByBlock") ((wcmatch str "CENTER2,BORDER*,DASHDOT*,DIVIDE,ACAD_ISO0[45689]W100,ACAD_ISO1[012345]W100,JIS_08_11,JIS_08_15,JIS_08_25,JIS_08_37,JIS_08_50,JIS_09_08,JIS_09_15,JIS_09_29,JIS_09_50,DOTTED_DASHED7") (if (not (tblsearch "LTYPE" "CENTER")) (command "_.-LINETYPE" "_L" "CENTER" "" "")) "CENTER") ((wcmatch str "DASHED,DOT,HIDDEN*,ACAD_ISO0[237]W100,JIS_02_0.7,JIS_02_1.0,JIS_02_1.2,JIS_02_2.0,JIS_02_4.0,SHORT_DASHED[56]") (if (not (tblsearch "LTYPE" "DASHED2")) (command "_.-LINETYPE" "_L" "DASHED2" "" "")) "DASHED2") ((cdr itm)))) (subst (cons key val) itm lst)) (append lst (list (cons key "ByBlock"))) ) ) (if (setq sel (ssget '((0 . "INSERT")))) (repeat (setq idx (sslength sel)) (block->0 (cdr (assoc 2 (entget (ssname sel (setq idx (1- idx))))))))) (command "_.REGEN") (princ) )