Set objects of a specific layer to the colour from block

February 12, 2022

Hey Lisp-Specialits!

I have a, I think, relative easy task to accomplish. I have a database of blocks with a specific colour on each layer and I want to set every object on a specific layer to the colour "from block".

I think it would need a lisp with a just a few lines to do that.

Unfortunatly I was not able to accomplish that simple task on my own after one year of studiyng lisp programs I collected and use for my work.

If anyone has some tips for a good book to learn the basics of programming lisps, I´d appriciate!

thanks for earlier assistance and thank you in advance!

This forum is great!

mfg

Philipp

February 12, 2022

Are you talking about each object in the block to be set to byblock?

Edited from here

(defun C:ByBlk ()
  (vl-load-com)
  (vlax-for blk (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    (vlax-for ent blk
      (vla-put-color ent 0)
    )
  )
  (vl-cmdf "_ATTSYNC" "N" "*")
)

if not please upload a sample drawing.

Edited February 12, 2022 by mhupp

February 13, 2022

Yes that would be the first step, but with question the layer it should set to a colour.

Here is a lisp that I got earlier in here but unfortunatly it just keeps restarting after layer selection, without changing the colour.

;;----------------------------------------------------------------------------;;
;; Change Color of Layer Base on Block Selection
(defun C:BBL (/ blk x tlist ename llist Color laylst)
  (while (setq blk (car (entsel "\nSelect a block: ")))
    (if (= (cdr (assoc 0 (entget blk))) "INSERT")
      (progn
        (setq tlist (tblsearch "BLOCK" (cdr (assoc 2 (entget blk))))
              ename (cdr (assoc -2 tlist))
        )
        (while ename
          (if (not (member (cdr (assoc 8 (entget ename))) llist))
            (setq llist (append (list (cdr (assoc 8 (entget ename)))) llist))
          )
          (setq ename (entnext ename))
        )
        (setq llist (vl-sort llist '<))
        (setq delim ","
              laylst
              (apply 'strcat
                     (cons (car llist)
                           (apply 'append
                                  (mapcar '(lambda (str) (list delim str))
                                          (cdr llist)
                                  )
                           )
                     )
              )
        )
        (prompt "\nPick New Layer Color:")
        (setq Color (acad_colordlg 1))
        (princ (strcat "\nLayer(s) in Block [" laylst "]"))
        (setq x (getstring "\nLayer to Change: "))
        (setvar 'cmdecho 0)
        (vl-cmdf "-Layer" "C" Color x "")
        (setvar 'cmdecho 1)
        (setq llist nil)
      )
      (princ "\nObject is not a Block Try again")
    )
  )
  (princ)
)

February 14, 2022

You can Start with AFRALISP for learning LISP, VLISP, VBA, etc. as well as the AutoCAD Developers Guide and Tutorials that come with AutoCAD.

If I read the question correctly...

The OP wants to insert a block that has objects on specific layers with specific colors, the OP would like for all object in the drawing that are on corresponding layers to be the same color. Or maybe they would like to choose the layers for the color as well.

February 14, 2022

No, the question is like this:

I have a bunch blocks with some ingredients: polylines, lines and attributes on different layers.

One layer configuration is for making a black and white plan for example. The colour of this entitys must be white.

One is on a specific colour for example: "30". I now want to change the apperence of the blocks, set with the blocks layer, so I want this colour inside the block with "by block".

When I put the block in the drawing it gets a layer and will get the colour 30 again.

Like in the posted lisp it should work like this:

-select block(s)

-select layer inside block (here the lisp seem to don´t work correctly)

-set the entitys which are drawn on this layer "by block"

I made this confusing configuration to see if the drawing order is correct (black and white lines above colour lines). Now I have about 300 blocks, and all must be corrected.

I think a lisp could make my work easier here.

please think about that I want to use the lisp in other tools than autocad. I get the colour selection box in the postet lisp, but somehow it wont change the colour, but restarts the program. Maybe it shoud work with easiest lisp, not autocad specific (is there a special key for "by block" like "30" for orange?)

Edited February 14, 2022 by Philipp

February 14, 2022

On 2/13/2022 at 12:44 PM, Philipp said:

Here is a lisp that I got earlier in here but unfortunately it just keeps restarting after layer selection, without changing the colour.

(here the lisp seem to don´t work correctly)

That lisp asks you to pick a color, Then it lists all layers that are in the block and ask you for input. if you input a layer name it will also change that layers color. if you dont enter a layer name it will only change the layer color of where the block is inserted on. You can enter multiple layer name but have to separate them with a , or it will error.

Need a sample drawing to sort out what you want.

February 14, 2022

I am not sure if I am following this correctly, Like MHUPP says, maybe a sample drawing could help - even a small portion of one, perhaps with a 'before' and 'after' block from what you have now and what you want it to be.

I might be confused you see. For plotting as a black and white plan, even to PDF I would control the colours with either a monochrome plot style table in the plotter dialogue or in the view ports select the layers and VP-Colour to be white, or both. Might be that you create a layout just for B&W plan, do it the VP-colour way then it looks B&W white on the screen in case you are showing anyone online.

After that you can draw however you want and set up all the blocks to by layer colours or byblock. Below is a routine I copied years ago (and before I routinely noted the source, if the originator is reading this, let m know so I can credit you). Command is attnorm and it sets everything to by-block, near the end is a commented section, just comment out ( ;; ) anything you don't want to change. Set all blocks to byblock, or bylayer and you should be OK?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:attnorm (/ myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (setq myblocklayer "0")
  (setq myblockcolour 0)
  (setq myblocklineweight aclnwtbyblock)
  (setq myblocklinetype "byblock")
  (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mynorm (myblocklayer myblockcolour myblocklineweight myblocklinetype / *error* adoc lst_layer func_restore-layers)
  (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

  (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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Sets the block attributes
;;add in here other attributes to change
          (vla-put-layer ent myblocklayer)
          (vla-put-color ent myblockcolour)
          (vla-put-lineweight ent myblocklineweight)
;;          (vla-put-linetype ent myblocklinetype)
;;end of setting up block attributes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

Edited February 14, 2022 by Steven P

February 14, 2022

2 hours ago, Philipp said:

No, the question is like this:

I have a bunch blocks with some ingredients: polylines, lines and attributes on different layers.

One layer configuration is for making a black and white plan for example. The colour of this entitys must be white.

One is on a specific colour for example: "30". I now want to change the apperence of the blocks, set with the blocks layer, so I want this colour inside the block with "by block".

When I put the block in the drawing it gets a layer and will get the colour 30 again.

Like in the posted lisp it should work like this:

-select block(s)

-select layer inside block (here the lisp seem to don´t work correctly)

-set the entitys which are drawn on this layer "by block" Is there a special key for "by block" like "30" for orange? Color ByBlock is 0.

Lots of similar code out there but most like Steven P's set a list of properties to ByBlock and Layer 0 which is how most blocks are created. They exist and have the properties of whatever layer you put them on. Rather than adding code to pick a layer you want the block on why not just use code that places it on Layer 0, select the blocks and pick the layer you want it on?

Another old lisp example with an author:

; Written By: Peter Jamtgaard 12/20/2006
;^P(or C:BlkByBlock (load "BlkByBlock.lsp"));BlkByBlock
(defun C:BlkByBlock (/ colBlockReference
                    ActDoc dprSelection
                    objSelection strBlockName
                 )
 (if (setq dprSelection (entsel "\nSelect Block: "))
  (progn
   (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object))
         dprSelection (car dprSelection)
         objSelection (vlax-ename->vla-object dprSelection)
   )
   (vla-StartUndoMark ActDoc)
   (BlkByBlock objSelection)
   (entupd dprSelection)
   (vla-EndUndoMark ActDoc)
  )
 )
 (prin1)
)

(defun BlkByBlock (objSelection / colBlockReference objBlock
                    strBlockName
                 )
 (if (= (type objSelection) 'ENAME)
  (setq objSelection (vlax-ename->vla-object objSelection)))
 (if (wcmatch (strcase (vla-get-objectname objSelection)) "*BLOCK*")
  (progn
   (vlax-for objBlock (vla-item
                       (vla-get-blocks ActDoc)
                       (vla-get-name objSelection)
                      )

    (vla-put-Color objBlock 0)
    (vla-put-Layer objBlock "0")
    (vla-put-linetype objBlock "ByBlock")
    (vla-put-Lineweight objBlock -1)
    (if(vla-get-Lineweight objBlock -1)
;    (vla-put-PlotStyleName objBlock "ByBlock")
    (if(=(getvar 'PStyleMode)0)(vla-put-PlotStyleName objBlock "ByBlock"))
   )
  )
 )
 (prin1)
)
(prin1)

February 15, 2022

StevenP: The code seems working except for the layer selection

I have uploaded a drawing.

Block 001 is the state I have now. The blocks colour is rigid.

When I change the objects on layer ...SYMB_BLOCK.. to "by layer" I have a block like the second.

This is the goal. I can now change the appearance by changing the layer, freezing the coloured block parts to have a b/w-block or even change colour or visability of all attributes in a drawing at once.

I the second code of tombu I get "no function" unfortunatly

NONAME_5.dwg

Edited February 15, 2022 by Philipp

February 15, 2022

This is the problem. The attributes are on their own layer so setting them to bylayer or byblock wont change their color. This lisp uses the layer the block is on to hard code all the entity's to that color. BUT you can only use that block on layers that use the same color. because if you have them spread across multiple layers with multiple colors after the lisp is done and you sync them. the last block processed will set the rest of the block colors.

(defun C:BlkColor (/ SS OBJ LAY COL BLK)
  (vl-load-com)
  (setq Drawing (vla-get-activedocument (vlax-get-acad-object)))
  (if (eq (cdr (assoc 0 (setq ent (entget (car (entsel "\nSelect Blocks")))))) "INSERT")
    (progn
      (setq lay (cdr (assoc 8 ent))
            name (cdr (assoc 2 ent))
            col (cdr (assoc 62 (tblsearch "layer" lay)))
            blk (vla-item (vla-get-blocks Drawing) name)
      )
      (vlax-for x blk
        (vla-put-Color x col)
      )
      (vl-cmdf "_ATTSYNC" "N" name)
      (vla-Regen Drawing acAllViewports)
    )
    (Prompt "\nNothing Selected")
  )
  (princ)
)

I suggest you move all block entity's you want to change color to layer "0" and set them to bylayer. This will change the colors automatically to what ever layer they are on.

see attached Drawing. 4 block on 4 different layers that are 4 different colors. if you move them to a different layer they will change color.

if you use above lisp they will be 4 block on 4 different layers but only one color.

NONAME_5_example.dxf

February 15, 2022

thx for the input mhupp!

The problem is that I made the blocks here for a reason and I dont want tochange them. The reason why I didnt set the layer: --symb_block to "from block" ist that I want to get the draw order correctly and see how they look.

Now I have about 300 blocks that are set up like I wanted but but in the end I want to change the appearance by the layer I give the blocks.

So I´ll have to change every single blocks symb_layer objects to "by block".

This is where a lisp could help me out, like the code that is written from Steven P but with layer selection.

The other problem I have is that in my posted code it says "(setq Color (acad_colordlg 1))" which I think is auto cad specific, this wont work with for example in ares commander or any other non auto cad lisp tool.

February 16, 2022

will this one from Lee Mac help I wonder, you can select all the blocks you want, then the tags in each set to By-Block, By-layer or a colour as you want

http://www.lee-mac.com/attributecolour.html

February 17, 2022

I think the lisp works fine but it does not for me because of the acad_colourdlg. It just does not work on cad software that is not autocad.

Id think I could go with the following program, but it should turn the selected layer objects directly to "by block" without colour selection to run without problems like it does in the c:attnorm from Steven P.

Ill try to figure out how it has to be written, but I am not really behind the lisp-language so if anyone has the solution, it´d help a lot!

;;----------------------------------------------------------------------------;;
;; Change Color of Layer Base on Block Selection
(defun C:BBL (/ blk x tlist ename llist Color laylst)
  (while (setq blk (car (entsel "\nSelect a block: ")))
    (if (= (cdr (assoc 0 (entget blk))) "INSERT")
      (progn
        (setq tlist (tblsearch "BLOCK" (cdr (assoc 2 (entget blk))))
              ename (cdr (assoc -2 tlist))
        )
        (while ename
          (if (not (member (cdr (assoc 8 (entget ename))) llist))
            (setq llist (append (list (cdr (assoc 8 (entget ename)))) llist))
          )
          (setq ename (entnext ename))
        )
        (setq llist (vl-sort llist '<))
        (setq delim ","
              laylst
              (apply 'strcat
                     (cons (car llist)
                           (apply 'append
                                  (mapcar '(lambda (str) (list delim str))
                                          (cdr llist)
                                  )
                           )
                     )
              )
        )
        (prompt "\nPick New Layer Color:")
        (setq Color (acad_colordlg 1))
        (princ (strcat "\nLayer(s) in Block [" laylst "]"))
        (setq x (getstring "\nLayer to Change: "))
        (setvar 'cmdecho 0)
        (vl-cmdf "-Layer" "C" Color x "")
        (setvar 'cmdecho 1)
        (setq llist nil)
      )
      (princ "\nObject is not a Block Try again")
    )
  )
  (princ)
)

February 17, 2022

6 hours ago, Philipp said:

I think the lisp works fine but it does not for me because of the acad_colourdlg. It just does not work on cad software that is not autocad.

Why do you list AutoCAD 2021 as your software in your profile?

Can you see now how that makes it difficult for others to help you?

Mine says Civil 3D 2021 because that's the software I use everyday.

Lots of others on here using similar software but not AutoCAD who offer help on here everyday like mhupp but none of them know what software you're using.

Update your profile!

February 17, 2022

4 hours ago, tombu said:

Why do you list AutoCAD 2021 as your software in your profile?

Can you see now how that makes it difficult for others to help you?

Mine says Civil 3D 2021 because that's the software I use everyday.

Lots of others on here using similar software but not AutoCAD who offer help on here everyday like mhupp but none of them know what software you're using.

Update your profile!

I use Graebert Ares Commander 2022 / 2023 which is a nearly similar program-code to draft sight I think, but fully set up new.

Unlike BricksCAD for example it doesn´t copy autocad, but provides every feature (and some more on the BIM-section) that Autocad is offering.

Unfortunatly there is not a very big online community I know, and its not listed in this forum here. The BIM-import features and from ground straight up programming with less unique tools in it makes a big Plus for me in this program, also the price.

February 18, 2022

I am not sure but I think all the posts may be a overkill, If you want red lines in a block to come out red use the correct ctb when plotting, we had various ctb's when plotting MONO.ctb means all colours are B-W, colour.ctb has predefined pen thickness for black then has colored objects as a color number. Also as mentioned block object on layer 0 so adopt the layer color, eg layer trees was set to 80.

You can edit the ctb files and save them, select color 1 red then shift scroll to color 254 and set them all to White, so no matter what color is in your dwg you will get all black lines. Again BW.ctb.

For us color 1-7 was set to black with various thickness, 9-250 set to color. Again Color.ctb.

PS had a A3 black white laser so color did not work but we never changed a dwg's colors.

Edited February 18, 2022 by BIGAL

February 18, 2022

I´ll give it a last try. I have here a code wich works fine to change every blocks colour from 0 to 256.

Whre in this code I must write the requirement that the only layer in the block that is affected is "ET_SYMB_BLOCK" and how?

 
(defun err-ubc (s)              ; If an error (such as CTRL-C) occurs
 
; while this command is active...
 
(if (/= s "Function cancelled")
 
(princ (strcat "\nError: " s))
 
)
 
(setq *error* olderr)           ; Restore old *error* handler
 
(princ)
 
);err-ubc
 
(DEFUN C:BBL (/ BLK CBL CBL2 C ACL ALY NLY NCL)
 
(setq olderr *error* *error* err-ubc)
 
(initget "?")
 
(while
 
(or (eq (setq C (getint "\nEnter new color number/<?>: ")) "?")
 
(null C)
 
(> C 256)
 
(< C 0)
 
);or
 
(textscr)
 
(princ "\n                                                     ")
 
(princ "\n                 Color number   |   Standard meaning ")
 
(princ "\n                ________________|____________________")
 
(princ "\n                                |                    ")
 
(princ "\n                       0        |      <BYBLOCK>     ")
 
(princ "\n                       1        |      Red           ")
 
(princ "\n                       2        |      Yellow        ")
 
(princ "\n                       3        |      Green         ")
 
(princ "\n                       4        |      Cyan          ")
 
(princ "\n                       5        |      Blue          ")
 
(princ "\n                       6        |      Magenta       ")
 
(princ "\n                       7        |      White         ")
 
(princ "\n                    8...255     |      -Varies-      ")
 
(princ "\n                      256       |      <BYLAYER>     ")
 
(princ "\n                                               \n\n\n")
 
(initget "?")
 
);while
 
(PROMPT "\nPick blocks to update. ")
 
(SETQ SS (SSGET '((0 . "INSERT"))))
 
(SETQ K 0)
 
(WHILE (< K (SSLENGTH SS))
 
(setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K)))))))
 
(SETQ CBL2 (CDR (ASSOC -2 CBL)))
 
(WHILE (BOUNDP 'CBL2)
 
(SETQ EE (ENTGET CBL2))
 
;Update layer value
 
(SETQ NCL (CONS 62 C))
 
(SETQ ACL (ASSOC 62 EE))
 
(IF (= ACL nil)
 
(SETQ NEWE (APPEND EE (LIST NCL)))
 
(SETQ NEWE (SUBST NCL ACL EE))
 
);if
 
(ENTMOD NEWE)
 
(SETQ CBL2 (ENTNEXT CBL2))
 
);end while
 
(ENTUPD BLK)
 
(SETQ K (1+ K))
 
);end while
 
(setq *error* olderr)
 
(princ)
 
);end updblkcl

February 18, 2022

(or(=(cdr(ASSOC 8 EE)) "ET_SYMB_BLOCK")(ENTMOD NEWE)) should only update if the layer name is not "ET_SYMB_BLOCK".

Try

(DEFUN C:BBL (/ *error* BLK CBL CBL2 C ACL ALY NLY NCL)

	(defun *error*  (s)              ; Localized *error* for if an error (such as CTRL-C) occurs
	; while this command is active...
		(if (/= s "Function cancelled")
			(princ (strcat "\nError: " s))
		)
		(princ)
	);*error*

	(initget "?")
	(while
		(or (eq (setq C (getint "\nEnter new color number/<?>: ")) "?")
		(null C)
		(> C 256)
		(< C 0)
		);or
		(textscr)
		(princ "\n                                                     ")
		(princ "\n                 Color number   |   Standard meaning ")
		(princ "\n                ________________|____________________")
		(princ "\n                                |                    ")
		(princ "\n                       0        |      <BYBLOCK>     ")
		(princ "\n                       1        |      Red           ")
		(princ "\n                       2        |      Yellow        ")
		(princ "\n                       3        |      Green         ")
		(princ "\n                       4        |      Cyan          ")
		(princ "\n                       5        |      Blue          ")
		(princ "\n                       6        |      Magenta       ")
		(princ "\n                       7        |      White         ")
		(princ "\n                    8...255     |      -Varies-      ")
		(princ "\n                      256       |      <BYLAYER>     ")
		(princ "\n                                               \n\n\n") (initget "?") 
	);while
	(PROMPT "\nPick blocks to update. ")
	(SETQ SS (SSGET '((0 . "INSERT"))))
	(SETQ K 0) 
		(WHILE (< K (SSLENGTH SS))
		(setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K))))))) 
		(SETQ CBL2 (CDR (ASSOC -2 CBL)))
			(WHILE (BOUNDP 'CBL2) 
			(SETQ EE (ENTGET CBL2))
			;Update layer value
			(SETQ NCL (CONS 62 C))
			(SETQ ACL (ASSOC 62 EE))
			(IF (= ACL nil)
				(SETQ NEWE (APPEND EE (LIST NCL)))
				(SETQ NEWE (SUBST NCL ACL EE))
			);if
			(or(=(cdr(ASSOC 8 EE))  "ET_SYMB_BLOCK")(ENTMOD NEWE))
			(SETQ CBL2 (ENTNEXT CBL2))
			);end while
			(ENTUPD BLK)
			(SETQ K (1+ K))
	);end while
	(setq *error* olderr)
	(princ)
);end BBL

February 19, 2022

and if I want to make every layer by block that is ET_SYMB_BLOCK but not the other ones?

How do I list it correctly, please correct my attempt:

(defun err-ubc (s)              ; If an error (such as CTRL-C) occurs
 
; while this command is active...
 
(if (/= s "Function cancelled")
 
(princ (strcat "\nError: " s))
 
)
 
(setq *error* olderr)           ; Restore old *error* handler
 
(princ)
 
);err-ubc
 
(DEFUN C:BBL (/ *error* BLK CBL CBL2 C ACL ALY NLY NCL)

	(defun *error*  (s)              ; Localized *error* for if an error (such as CTRL-C) occurs
	; while this command is active...
		(if (/= s "Function cancelled")
			(princ (strcat "\nError: " s))
		)
		(princ)
	);*error*

	(initget "?")
	(while
		(or (eq (setq C (getint "\nEnter new color number/<?>: ")) "?")
		(null C)
		(> C 256)
		(< C 0)
		);or
		(textscr)
		(princ "\n                                                     ")
		(princ "\n                 Color number   |   Standard meaning ")
		(princ "\n                ________________|____________________")
		(princ "\n                                |                    ")
		(princ "\n                       0        |      <BYBLOCK>     ")
		(princ "\n                       1        |      Red           ")
		(princ "\n                       2        |      Yellow        ")
		(princ "\n                       3        |      Green         ")
		(princ "\n                       4        |      Cyan          ")
		(princ "\n                       5        |      Blue          ")
		(princ "\n                       6        |      Magenta       ")
		(princ "\n                       7        |      White         ")
		(princ "\n                    8...255     |      -Varies-      ")
		(princ "\n                      256       |      <BYLAYER>     ")
		(princ "\n                                               \n\n\n") (initget "?") 
	);while
	(PROMPT "\nPick blocks to update. ")
	(SETQ SS (SSGET '((0 . "INSERT"))))
	(SETQ K 0) 
		(WHILE (< K (SSLENGTH SS))
		(setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K))))))) 
		(SETQ CBL2 (CDR (ASSOC -2 CBL)))
			(WHILE (BOUNDP 'CBL2) 
			(SETQ EE (ENTGET CBL2))
			;Update layer value
			(SETQ NCL (CONS 62 C))
			(SETQ ACL (ASSOC 62 EE))
			(IF (= ACL nil)
				(SETQ NEWE (APPEND EE (LIST NCL)))
				(SETQ NEWE (SUBST NCL ACL EE))
			);if
			(or (=(cdr(ASSOC 8 EE))		"ET_SYMB_GREY"
										"ET_ATTR_ABMESS"
										"ET_ATTR_BEZ"
										"ET_ATTR_LEIST"
										"ET_ATTR_LV"
										"ET_ATTR_SCHALT"
										"ET_ATTR_SCHUTZ"
										"ET_ATTR_STROM"
										"ET_ATTR_TUER"
										"ET_ATTR_TYP"
										"ET_ATTR_VERT"}	)(ENTMOD NEWE))
			(SETQ CBL2 (ENTNEXT CBL2))
			);end while
			(ENTUPD BLK)
			(SETQ K (1+ K))
	);end while
	(setq *error* olderr)
	(princ)
);end BBL

February 22, 2022

On 2/19/2022 at 9:26 AM, Philipp said:
and if I want to make every layer by block that is ET_SYMB_BLOCK but not the other ones?

How do I list it correctly, please correct my attempt:
....

;; Change this
(SETQ SS (SSGET '((0 . "INSERT"))))
;; to this
(SETQ SS (SSGET '((0 . "INSERT")(2 . "ET_SYMB_BLOCK"))))

Sign In

Set objects of a specific layer to the colour from block

Recommended Posts

Philipp

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

SLW210

Steven P

tombu

mhupp

Philipp

SLW210

Philipp

mhupp

Steven P

tombu

Philipp

mhupp

Philipp

Steven P

Philipp

tombu

Philipp

BIGAL

Philipp

tombu

Philipp

ronjonp

Join the conversation

SLW210

Steven P

tombu

Tutorials

Forums

Activity