Turn layers of the objects to color 8 inside the block

[vinodkl]

Hello Everyone,

I hope everyone is doing well and staying safe.

I am looking for a lisp that can turn the layers of the object to color 8 inside the block. I did try searching the forum and was not able to find one.

I have been using the lisp "FIXBLOCK" but this lisp turns the objects to  "0" layer inside the block and this doesn't fix my issue.

I get floor plan from the client and I need to turn the floor plan color to "color 8" and then start placing devices on top of that. But these floor plans are made up of blocks and nested blocks, so I need to get into the block editor and then add the objects to "group filter" and then open up the layer manager and change the color of all the layers in group filter to color "8" which is tedious.

So can anyone help me out with the lisp which can do this?

Thanks in advance.

PS: I have also used the lisp "BELTB" and it doesn't seem to solve my issue.

[pbejse]

A better solution is, use SETBYLAYER and select BYBLOCK, right then, the block will inherit the colors of the layer it is assigned to or also by assigning a color to the object

or

(Defun c:ct8 ( / a )
(while (setq a (tblnext "BLOCK" (null a)))
      (vlax-for
             itm
                (vla-item
                      (vla-get-blocks
                            (vla-get-activedocument
                                  (vlax-get-acad-object)))
                      (cdr (assoc 2 a)))
            (if
                  (vlax-write-enabled-p itm)

                       (vlaX-put itm 'color 8)
                       )))
      )

You need to add check for XREF/Locked layers and such...

[Anonymous]

Dear Vinod,

Please try this one, I got this from this group only and working fentastic. Here you have to give input color and command name is "CR". After applying command, you should give color number, what you wish (For Gray color - 😎

(defun c:CR(/ adoc blocks color ins lays ss lst *error*)
;;; Color Area - - Changes in the color of selected items in the area
;;;http://www.cadtutor.net/forum/showthread.php?t=533&page=8
;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036
;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18
(defun *error* (msg)(bg:layer-status-restore)(princ msg)(princ))
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc)
lays (vla-get-layers adoc)
) ;_ end of setq
(if (and (setq color (acad_colordlg 256))
(setq ss (ssget))
(progn
(repeat (setq ins (sslength ss)) ;_ end setq
(setq lst (cons (ssname ss (setq ins (1- ins))) lst))
) ;_ end repeat
lst
) ;_ end of progn
) ;_ end of and
(progn
(vla-startundomark adoc)
(bg:layer-status-save)
(foreach ins lst
(setq ins (vlax-ename->vla-object ins))
(if (= (vla-get-objectname ins) "AcDbBlockReference")
(if (vlax-property-available-p ins 'path)
(princ "\nThis is external reference! Skip.")
(progn
(_pl:block-color blocks ins color lays)
(Change-Object-Color ins color)
)
) ;_ end of if
(Change-Object-Color ins color)
) ;_ end of if

) ;_ end of repeat
(vla-regen adoc acallviewports)
(bg:layer-status-restore)
(vla-endundomark adoc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)
(vlax-for e (vla-item blocks (vla-get-name ins))
(setq lay (vla-item lays (vla-get-layer e)))
(if (= (vla-get-freeze lay) :vlax-true)
(progn (setq layfrz (cons lay layfrz))
(vla-put-freeze lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(if (= (vla-get-lock lay) :vlax-true)
(progn (setq layloc (cons lay layloc))
(vla-put-lock lay :vlax-false)
) ;_ end of progn
) ;_ end of if
(vl-catch-all-apply (function vla-put-color) (list e color))
(if (and (= (vla-get-objectname e) "AcDbBlockReference")
(not (vlax-property-available-p e 'path))
) ;_ end of and
(_pl:block-color blocks e color lays)
) ;_ end of if
(foreach i layfrz (vla-put-freeze i :vlax-true))
(foreach i layloc (vla-put-lock i :vlax-true))
) ;_ end of vlax-for
) ;_ end of defun
(defun Change-Object-Color (Obj Color / txtstr tmp txt)
;;;=============================================== =========================
;;;_color object start
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if	(and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-TextColor (list Obj acByBlock)) ;_Color
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj acByBlock));_Color
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp acByBlock) ;_Color
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq txtstr
((lambda (mtext / text str)
(setq Text "")
(while (/= Mtext "")
(cond
((wcmatch(strcase (setq Str (substr Mtext 1 3)))"{\\C") ;_ end of wcmatch
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext)))) ;_ end of setq
)
((wcmatch(strcase (setq Str (substr Mtext 1 2)))"\\C")
(setq Mtext(substr Mtext (+ 2 (vl-string-search ";" Mtext))))
)
((wcmatch(strcase (setq Str (substr Mtext 1 2))) "\\[{}]")
(setq Text (strcat Text (substr Mtext 1 2))
Mtext (substr Mtext 3)
) ;_ end of setq
)
((wcmatch (substr Mtext 1 1) "[{}]")
(setq Mtext (substr Mtext 2))
)
(t
(setq Text (strcat Text (substr Mtext 1 1))
Mtext (substr Mtext 2)
) ;_ end of setq
)
) ;_ end of cond
) ;_ end of while
text
) ;_lambda
txtstr
)
)
(vlax-put-property Obj 'TextString (strcat "{\\C" (itoa color) ";" txtstr "}"))
);_progn
)

) ;_ end of progn
) ;_ end of if
;;;_color object end
;;;=============================================== =========================
) ;_ end of defun
(defun bg:layer-status-restore ()
(foreach item *BG_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *BG_LAYER_LST* nil)
) ;_ end of defun

(defun bg:layer-status-save ()
(setq *BG_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *BG_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*BG_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun
(progn
(princ
"\ColorA - Changes in the color of selected items in the area"
) ;_ end of princ
(princ)
) ;_ end of progn

[vinodkl]

Hi @pbejse,

Thanks for looking into it. 

Unfortunately, selecting BYBLOCK when using SETBYLAYER is not working when the block has nested blocks in them and I don't want to change the color of the object inside the block to BYBLOCK.

And the lisp provided changes all the objects color to "color 8" and when I use this lisp the title block and other information inside the drawing along with floor plan are changing their color to "color 8" which I don't want to happen.

And just in case I use this lisp at my office, some of them at my office have the habit of setting everything to bylayer and they just type in the command "SETBYLAYER" and select everything inside the drawing and double enter and doing so will again make all the objects color back to the color which assigned to the layer.

So I am looking so something like I select the block and the color of the layers used inside the block to turn into color 8(Bylayer).

[vinodkl]

Hi @Anonymous ,

Thank you for your reply I really appreciate it.

This is a good lisp, but as said in my above post I looking for a lisp that turn the color of the layers(bylayer) of the object inside the block to color "8".

[pbejse]

---

@vinodkl wrote:

Hi @pbejse,

So I am looking so something like I select the block and the color of the layers used inside the block to turn into color 8(Bylayer).

---

And dont change the block inside of it YES?

Do you want an option to select a color? or is it always 8?

(defun c:Btc  (/ block clr)
      (prompt "\nSelect Block to modify")
      (if (and
                (setq block (ssget "_+.:S:E" '((0 . "INSERT"))))
                (setq clr (acad_colordlg 8 nil))
                )
            (vlax-for
                   itm
                      (vla-item
                            (vla-get-blocks
                                  (vla-get-activedocument
                                        (vlax-get-acad-object)))
                            (getpropertyvalue
                                  (ssname block 0)
                                  "BlockTableRecord/Name")
                            )
                  (if
                        (vlax-write-enabled-p itm)
                             (vlaX-put itm 'color clr)
                             )))
      (princ)
      )

[john.uhden]

I would say that your desired process would be fine if the blocks were xrefs because the layers within have unique names.  But if the blocks you select are not xrefs, then you could be changing the color of a layer that is used throughout the drawing... layer "0" being the primary problem.

I agree with @pbejse that you would be better changing all the objects in the block to color ByBlock, and then changing the color of the block entity to 8 or any other color you might like at a later date, like 254 which is a little lighter shade of grey.  Actually, it will work the same if you put the block on a layer that's color 8.

I know I have submitted it before, but if you don't have a utility to make the change, then just ask and I'll post my BYBLOCK.lsp again.

[ВeekeeCZ]

---

@vinodkl wrote:

... so I need to get into the block editor and then add the objects to "group filter" and then open up the layer manager and change the color of all the layers in group filter to color "8" which is tedious. ...

---

Just a quick tip. I've added "All Visible Layers" layer property filter into my template. The properties are "ON" & "Thawed". Then all you need to do is isolate all layers inside the block editor and activate the filter.

[john.uhden]

I swear you are just like Annie Oakley.

[vinodkl]

Hi,

>>And don't change the block inside of it YES?<<

Yes I want to change the color of the nested blocks as well.

>>Do you want an option to select a color? or is it always 8?<<

Mostly it's color 8 but still an option to select the color would be good.

I tried the lisp provided, but it turns out that it's just changing the color of the object to color 8 and not the object's layers (by layer) color to color 8. 

I hope I am not confusing you.

[vinodkl]

Hi @john.uhden,

Yes, If the floor plan was an Xref It would be easy and the color of the layer can be changed in an instance from layer manager, but since the floor plan is a block and consist of nested block it becomes difficult to know layers inside the floor plan and as the drawing consists of many other details inside it and changing the color of the all the layers inside the drawing to color 8 is a bad idea. If the color of the object inside the block is changed to BYBLOCK and incase if SETBYLAYER is used all the objects will return back to color BYLAYER. 

[pbejse]

---

@vinodkl wrote:

I tried the lisp provided, but it turns out that it's just changing the color of the object to color 8 and not the object's layers (by layer) color to color 8. 

I hope I am not confusing you.

---

If the object inside the block is layer "banana" , you want that layer to be color 8 if its not yet color 8, YES? or a layer named "8" with color 6?

Yes you are confusing me 😄

[vinodkl]

Hi @ВeekeeCZ,

Sorry, I didn't quite understand that. Can you explain that clearly?

I guess I am not able to put this in a proper way. Let me explain.

I get floor plan along with the template and which consists of lots of other details which I won't be working on and I need to set the floor plan color to color 8.

Here is an example:

Here is a floor plan block inside the drawing which consists of nested blocks

Here is what I want the lisp to do. It needs to change the color of the layers inside the floor plan block to color 8.

After this, I could also create a property filter by the name "Floor plan" and filter it using the color 8.

I think I have explained it better now. 

[ВeekeeCZ]

I just wanted to give you a quick tip which can make your workflow much simpler.

Create a custom layer filter "All Visible Layers" and save it to your template.

See how it works HERE 

Select a block, open it in the block editor, isolate all layers inside the editor, then use your filter.

I know it won't cover nested-nested layers, but it was just a simple tip.

Anyway, a little step farther would be something like this. Just select a block or two...

(vl-load-com)

(defun c:BlockLayerFilter (/ *error* eco :BlockAllNestedLayers s i lst)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if eco (setvar 'cmdecho eco))
    (princ))

  (defun :BlockAllNestedLayers (blk lst)
    (if (setq e (tblobjname "BLOCK" blk))
      (while e
	(setq l (cdr (assoc 8 (entget e))))
	(if (not (member l lst)) (setq lst (cons l lst)))
	(if (= "INSERT" (cdr (assoc 0 (entget e))))
	  (setq lst (:AllBlockLayers (cdr (assoc 2 (entget e))) lst)))
	(setq e (entnext e))))
    lst)

  ; --------------------------------------------------------------------------------------------------------------------------------------

  (princ "\nBlock required, ")
  (if (setq s (ssget "_:S" '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength s))
	(setq lst (:BlockAllNestedLayers (cdr (assoc 2 (entget (ssname s (setq i (1- i)))))) lst)))
      (setq eco (getvar 'cmdecho))
      (setvar 'CMDECHO 0)
      (command "_.-LAYER" "_Filter" "_Delete" "Block Nested Layers")
      (if (< 0 (getvar 'CMDACTIVE)) (command))
      (if (setq lst (vl-remove "0" lst))
	(progn
	  (command "_.-LAYER" "_Filter" "_New" "_Group" "All" (apply 'strcat (mapcar '(lambda (l) (strcat l ",")) lst)) "Block Nested Layers" "")
	  (initdia)
	  (command "_.LAYER")))))
  (*error* "end")
)

[vinodkl]

Hi @ВeekeeCZ 

It looks like the lisp is not working.

This is what the command history looks like after running the lisp.

[ВeekeeCZ]

Try this. It was renamed but one instance left not.

(vl-load-com)

(defun c:BlockLayerFilter (/ *error* eco :BlockAllNestedLayers s i lst)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if eco (setvar 'cmdecho eco))
    (princ))

  (defun :BlockAllNestedLayers (blk lst)
    (if (setq e (tblobjname "BLOCK" blk))
      (while e
	(setq l (cdr (assoc 8 (entget e))))
	(if (not (member l lst)) (setq lst (cons l lst)))
	(if (= "INSERT" (cdr (assoc 0 (entget e))))
	  (setq lst (:BlockAllNestedLayers (cdr (assoc 2 (entget e))) lst)))
	(setq e (entnext e))))
    lst)

  ; --------------------------------------------------------------------------------------------------------------------------------------

  (princ "\nBlock required, ")
  (if (setq s (ssget "_:S" '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength s))
	(setq lst (:BlockAllNestedLayers (cdr (assoc 2 (entget (ssname s (setq i (1- i)))))) lst)))
      (setq eco (getvar 'cmdecho))
      (setvar 'CMDECHO 0)
      (command "_.-LAYER" "_Filter" "_Delete" "Block Nested Layers")
      (if (< 0 (getvar 'CMDACTIVE)) (command))
      (if (setq lst (vl-remove "0" lst))
	(progn
	  (command "_.-LAYER" "_Filter" "_New" "_Group" "All" (apply 'strcat (mapcar '(lambda (l) (strcat l ",")) lst)) "Block Nested Layers" "")
	  (initdia)
	  (command "_.LAYER")))))
  (*error* "end")
)

[vinodkl]

Hi @ВeekeeCZ,

Thanks for looking into it🙂

But the code is still not working.

[ВeekeeCZ · Accepted solution]

Found it. My test blocks were too simple. Two more letters needed.  

Sorry about the inconvenience. HTH

(vl-load-com)

(defun c:BlockLayerFilter (/ *error* eco :BlockAllNestedLayers s i lst)

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if eco (setvar 'cmdecho eco))
    (princ))

  (defun :BlockAllNestedLayers (blk lst / e l)
    (if (setq e (tblobjname "BLOCK" blk))
      (while e
	(setq l (cdr (assoc 8 (entget e))))
	(if (not (member l lst)) (setq lst (cons l lst)))
	(if (= "INSERT" (cdr (assoc 0 (entget e))))
	  (setq lst (:BlockAllNestedLayers (cdr (assoc 2 (entget e))) lst)))
	(setq e (entnext e))))
    lst)

  ; --------------------------------------------------------------------------------------------------------------------------------------

  (princ "\nBlock required, ")
  (if (setq s (ssget "_:S" '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength s))
	(setq lst (:BlockAllNestedLayers (cdr (assoc 2 (entget (ssname s (setq i (1- i)))))) lst)))
      (setq eco (getvar 'cmdecho))
      (setvar 'CMDECHO 0)
      (command "_.-LAYER" "_Filter" "_Delete" "Block Nested Layers")
      (if (< 0 (getvar 'CMDACTIVE)) (command))
      (if (setq lst (vl-remove "0" lst))
	(progn
	  (command "_.-LAYER" "_Filter" "_New" "_Group" "All" (apply 'strcat (mapcar '(lambda (l) (strcat l ",")) lst)) "Block Nested Layers" "")
	  (initdia)
	  (command "_.LAYER")))))
  (*error* "end")
)

[pbejse]

[vinodkl]

Hi,

Thank you so much for helping out😀

Though not the away I wanted it to work still, it works awesome😊

You are great!!

Thank you everyone who tried to help me out😊👍