Set elements on specific layer to colour

[Philipp]

Hello!

 

I have found a nice lisp that can change selected blocks to a specific colour definition

Isnt it just a small change in it to chose one specific layer to change the colour, not all elements?

Please help, I have tried to implemet codes from other programs, but cant manage it to get it done

 

Here is the code:

(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

 

[mhupp]

Need more info on what you want to do. will suggest to change the following tho.

 

(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

to

  (prompt "\nPick New Layer Color:")
  (setq C (acad_colordlg 1)) ;defaults red

 

Edited June 5, 2021 by mhupp

[BIGAL]

Mhupp use (setq color (acad_colordlg 1) ) for color select very simple, change 1 for default color to different number.

 

also (acad_truecolordlg '(62 . 215))

 

 

[mhupp]

1 hour ago, BIGAL said:

Mhupp use (setq color (acad_colordlg 1) ) for color select very simple, change 1 for default color to different number.

 

also (acad_truecolordlg '(62 . 215))

 

 

Yes that is what I posted. Didnt know about the 2nd one tho.

[Philipp]

ok, thx for the reply but thats not what I wanted

 

I have blocks with elements that are set bylayer, and elements that should be set as byblock

 

so after selecting the colour, wich the prog does nicely, I want to be asked:

"Type layer selection" to filter the affected elements in the blocks. If I type in for example "Layer_1" only the elements with the Layer_1 should be colour changed

 

 

 

[mhupp]

This will asks user to select a block.

Ask what color they want.

Display what layers are used by the block with temp dcl file

let the user select they layers they want to change.

Change layers selected with the color selected

loop until canceled.

 

Will display error if selecting anything other then a block.

"Object is not a block. "

 

 

Combined these lisps

https://forums.augi.com/showthread.php?18929-Block-layer-Lisp-Finder

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-do-i-display-a-list-of-layers-in-a-dcl-list-box/td-p/9454310

 

 

;;----------------------------------------------------------------------------;;
;; Change Color of Layer Base on Block Selection
(defun C:BBL (/ blk tlist ename llist Color)
  (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 '<))
        (prompt "\nPick New Layer Color:")
        (setq Color (acad_colordlg 1))
        (setq LayLst (AT:ListSelect "Select Layers to Change Color" "Layer Names" 30 60 "true" llist))
        (setvar 'cmdecho 0)
        (foreach x LayLst
          (vl-cmdf "-Layer" "C" Color x "")
        )
        (setvar 'cmdecho 1)
        (setq llist nil)
      )
      (princ "\nObject is not a block ")
    )
  )
  (princ)
)
  ;; List Select Dialog (Temp DCL list box selection, based on provided list)
  ;; title - list box title
  ;; label - label for list box
  ;; height - height of box
  ;; width - width of box
  ;; multi - selection method ["true": multiple, "false": single]
  ;; lst - list of strings to place in list box
  ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
(defun AT:ListSelect (title label height width multi lst / fn fo d f)
  (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
  (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;")
                   (strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
                   (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
                   (strcat "width = " (vl-princ-to-string width) ";")
                   (strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
             )
    (write-line x fo)
  )
  (close fo)
  (new_dialog "list_select" (setq d (load_dialog fn)))
  (start_list "lst")
  (mapcar (function add_list) lst)
  (end_list)
  (setq item (set_tile "lst" "0"))
  (action_tile "lst" "(setq item $value)")
  (setq f (start_dialog))
  (unload_dialog d)
  (vl-file-delete fn)
  (if (= f 1)
    ((lambda (s / i s l)
       (while (setq i (vl-string-search " " s))
         (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
         (setq s (substr s (+ 2 i)))
       )
       (reverse (cons (nth (atoi s) lst) l))
     )
      item
    )
  )
)

 

Edited June 6, 2021 by mhupp
updated code to not show duplicate layer names

[Philipp]

Just tried the code and get "undefined parameter"

Dont know if its understood what I wanted to do: I have a file with many blocks with layers that are the same inside every block.

Now I try to change every element in the blocks to a colour, lets say fromBlock. The Blocks are in the colour the block-layer says now.

Unfortunatly some texts inside the Block arent readable anymore now, so I have to change every "Layer-Text" to FromLayer to make them white again.

 

The program I posted works for the first step, but Id need to chose "Layer-Text" to apply a colour on this specific layer

 

[mhupp]

Their are two parts to the lisp I posted. the BBL and AT:ListSelect  Sounds like you didn't copy it all there should be a total of 71 lines.

The lisp you posted changes the color of every entity in the block to byblock. This overwrites everything in the block to the color of the layer the block was inserted on.

My lisp assumes you have everything as bylayer Coloring. This is the easiest why to change colors not only for the block your working on but for all blocks that have something on that layer.

 

 

[Philipp]

I think the problem is that my cad-program (Ares Commander), gives the program not the right parameter when selecting the colour.

In the program Ive posted the colour has to be defined by number. I your code the colour-selection shows up, when I press ok, it says "invalid-parameter"

[mhupp]

acad_colordlg outputs a number shown in this box

 

It sounds like its running into the error when its either creating or calling the DCL file so i have reworked that part of the lisp.

the lisp now output the layers used in block to the command line this allows you to use your mouse to select the name and Ctrl+C Ctrl+V

or you can type it but if its not exact it will not change anything. dont think it has to match upper and lowercase.

this is what it will look like.

 

Select a block:
Pick New Layer Color:
Layer(s) in Block [NewLayer1,NewLayer2,NewLayer3,NewLayer4]
Layer to Change: NewLayer2

 

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

 

Edited June 7, 2021 by mhupp