Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

change all to 0 layer, by layer, including block and block in block

35 REPLIES 35
SOLVED
Reply
Message 1 of 36
Anonymous
17014 Views, 35 Replies

change all to 0 layer, by layer, including block and block in block

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.

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/change-all-block-element-to-layer-0-w...

I someone who can help me?

Jo

 
 
 
35 REPLIES 35
Message 2 of 36
Kent1Cooper
in reply to: Anonymous


@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

Kent Cooper, AIA
Message 3 of 36
Lee_Mac
in reply to: Anonymous

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

 

Message 4 of 36
Anonymous
in reply to: Kent1Cooper

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?
Message 5 of 36
Anonymous
in reply to: Lee_Mac

Hi Lee, brilliat! It works as a dream 🙂
Thank you both of you Guys 🙂
Jo
Message 6 of 36
Lee_Mac
in reply to: Anonymous

JoRodh wrote:
Hi Lee, brilliat! It works as a dream 🙂
Thank you both of you Guys 🙂
Jo

 

You're welcome! Smiley Happy

 

Lee

Message 7 of 36
Kent1Cooper
in reply to: Anonymous


@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

Kent Cooper, AIA
Message 8 of 36
Anonymous
in reply to: Kent1Cooper

Thank you a lot Kent, I will check this lisp during the day.
Message 9 of 36
Lee_Mac
in reply to: Anonymous

Just be careful not to miss the selection when prompted, as Kent's code will error Smiley Wink

Message 10 of 36
Kent1Cooper
in reply to: Lee_Mac


@Lee_Mac wrote:

Just be careful not to miss the selection when prompted, as Kent's code will error Smiley Wink


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.

Kent Cooper, AIA
Message 11 of 36
Anonymous
in reply to: Kent1Cooper

Thank you Kent Cooper
I did some checks and Kents lisp work perfect as well.
Thanks again guys.
Jo
Message 12 of 36
Anonymous
in reply to: Lee_Mac


@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!

Message 13 of 36
Anonymous
in reply to: Kent1Cooper

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 !

Message 14 of 36
ВeekeeCZ
in reply to: Anonymous

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.

 

Spoiler
;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) 
)
Message 15 of 36
Anonymous
in reply to: ВeekeeCZ

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.

Message 16 of 36
ВeekeeCZ
in reply to: Anonymous


@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?

Message 17 of 36
Anonymous
in reply to: ВeekeeCZ

Yeah! I see. Thanks for your help, friend!
Message 18 of 36
Anonymous
in reply to: Anonymous

My friend, I've tried entering as your direction. 

I have tried loading them but again, this isn't working because I don't know much about the lisp.
Can you help me change CENTER, DASHED2 into color 9? I really need it for now!
Thanks again, a million blessings upon you for your generous spirit!!
 
 
Message 19 of 36
ВeekeeCZ
in reply to: Anonymous

Slightly tested.

 

Spoiler
;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) 
)
Message 20 of 36
Anonymous
in reply to: ВeekeeCZ

Thanks a million! it work perfect as well but still cann't work with "block in block". Smiley Sad

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost