Lisp colour change for all layers and blocks

Thank you very much. this probably has to be one of the oldest string around but so darn useful. thanks again for you hard work and efforts.

I want to use this lisp routine to change all of the colors white and run it through scriptpro to apply to an entire folder of drawings. The problem I am running into is that I have to click ok in each drawing to make the command complete to change the colors. Is there a way I can get it to automatically complete the command and keep moving on?

thanks!

Please read the Code posting guidelines and edit your post to include the Code in Code Tags.

Sorry that was my first post. I'll delete it and fix it before i post it again.

You just need to wrap in Code Tags (the #) or manually like

your code here[/ CODE] (no space between / and CODE).

You get

[code]your code here

Awesome code, been using it for years! I am also looking for a command-line version as until now I’ve been making do with a (poorly assembled) auto hotkey solution for batch processing… Any chance of getting a revised piece of code to support command line operation? This routine totally deserves it!

Awesome code, been using it for years! I am also looking for a command-line version as until now I’ve been making do with a (poorly assembled) auto hotkey solution for batch processing… Any chance of getting a revised piece of code to support command line operation? This routine totally deserves it!

add minor change in #14

Oops! didn't spot that haha. Brilliant, cheers!

Hello VVA,

I was happy to find your Lisp cause it was meant to do exactly what I needed. Unfortunately when i run it, nothing happens. Actually it asks me for Xref, let me choose color, but doesn't execute.

Dit anyone test the routine?

New variant (much longer than the previous )

(defun C:COLORXLAY (/ doc col xreflist ret)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for item (vla-get-Blocks doc)
     (if (= (vla-get-IsXref item) :vlax-true)
        (setq xreflist (cons (vla-get-name item) xreflist))
       )
   )
 (if xreflist
 (if (and (setq ret (_dwgru-get-user-dcl "Select XREF " (acad_strlsort xreflist) t))
          (setq col (acad_colordlg 7 nil))
          )
   (progn
     (setq ret (apply 'strcat (mapcar '(lambda(x)(strcat x "|*,")) ret)))
   (vla-startundomark doc)
   (vlax-for item (vla-get-Layers doc)
     (if (wcmatch (vla-get-name item) ret)
(vla-put-color item col)
     )
     )
       (vla-endundomark doc)
   )
 ) ;_ end of if
   (alert "No XREF Found")
   )
 (princ)
) ;_ end of defun

;;; ************************************************************************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Candidate)
;;; *
;;; * Inquiry of value at the user through a dialogue window
;;; *
;;; *
;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA)
;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden
;;; - Processing of several columns
;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)
(defun _DWGRU-GET-USER-DCL (ZAGL        INFO-LIST   MULTI
                           /           FL          RET
                           DCL_ID      MAXROW      MAX_COUNT_COL
                           COUNT_COL   I           LISTBOX_HEIGHT
                           LST         _LOC_FINISH _LOC_CLEAR
                           NCOL
                          )
;| 
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without scrolling is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
    http://dwg.ru/f/showthread.php?p=203746#post203746
* Parameters of a call:
   zagl - heading of a window [string]
   info-list - the list of line values [List of String]
   multi - t - the plural choice is resolved, nil-is not present
     
* Returns:
The list of the chosen lines or nil - a cancelling
* the Example
(_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") nil); _-> ("First") 
(_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") t); _-> ("First"  "Second ")
(_dwgru-get-user-dcl " Specify a variant "
  (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)
(_dwgru-get-user-dcl " Specify a variant, using CTRL and SHIFT for a choice "
  (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
 (setq MAXROW 40) ;_  max lines without scrolling (To it 3 more lines further will be added)
 (setq MAX_COUNT_COL 5) ; _ a maximum quantity of columns
;;============== Local functions START========================

 (defun _LOC_FINISH ()
   (setq I   0
         RET NIL
   ) ;_ end ofsetq
   (repeat COUNT_COL
     (setq I (1+ I))
     (setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
   ) ;_ end ofrepeat
   (setq RET (reverse RET))
   (done_dialog 1)
 ) ;_ end ofdefun
 (defun _LOC_CLEAR (NOMER)
   (setq I 0)
   (repeat COUNT_COL
     (setq I (1+ I))
     (if (/= I NOMER)
       (progn
         (start_list (strcat "info" (itoa I)))
         (mapcar 'add_list (nth (1- I) LST))
         (end_list)
       ) ;_ end ofprogn
     ) ;_ end ofif
   ) ;_ end ofrepeat
 ) ;_ end ofdefun

;;;==================== Local functions END ==================================
;;;==================== MAIN PART ===============================================
 (if (null ZAGL)(setq ZAGL "Select")) ;_ end if
 (if (zerop (rem (length INFO-LIST) MAXROW))
   (setq COUNT_COL (/ (length INFO-LIST) MAXROW))
   (setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0))))
 ) ;_ end ofif
 (if (> COUNT_COL MAX_COUNT_COL)
   (setq COUNT_COL MAX_COUNT_COL)
 )
 (setq LISTBOX_HEIGHT (+ 3 MAXROW))
  ;_ We add 3 lines for appearance and for exception boundary scroll
 (if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
   (setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
 ) ;_ end ofif
 (setq I 0)
 (setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
 (setq RET (open FL "w")
       LST NIL
 ) ;_ end ofsetq
 (mapcar '(lambda (X) (write-line X RET))
         (append (list "dwgru_get_user : dialog { "
                       (strcat "label=\"" ZAGL "\";")
                       ": boxed_row {"
                       "label = \"Value\";"
                 ) ;_ end oflist
                 (repeat COUNT_COL
                   (setq LST
                          (append
                            LST
                            (list
                              " :list_box {"
                              "alignment=top ;"
                              (if MULTI
                                "multiple_select = true ;"
                                "multiple_select = false ;"
                              ) ;_ end ofif
                              "width=31 ;"
                              (strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
                              "is_tab_stop = false ;"
                              (strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
                            ) ;_ end oflist
                          ) ;_ end ofappend
                   ) ;_ end ofsetq
                 ) ;_ end ofrepeat
                 (list
                   "}"
                   ":row{"
                   "ok_cancel_err;}}"
                 ) ;_ end oflist
         ) ;_ end of list
 ) ;_ end of mapcar
 (setq RET (close RET))
 (if (and (null (minusp (setq DCL_ID (load_dialog FL))))
          (new_dialog "dwgru_get_user" DCL_ID)
     ) ;_ end and
   (progn
     (setq LST INFO-LIST)
     ((lambda (/ RET1 BUF ITM)

        (repeat (1- COUNT_COL)
          (setq I '-1)
          (while (and (setq ITM (car LST))
                      (< (setq I (1+ I)) MAXROW)
                 ) ;_ end of and
            (setq BUF (cons ITM BUF)
                  LST (cdr LST)
            ) ;_ end of setq
          ) ;_ end ofwhile
          (setq RET1 (cons (reverse BUF) RET1)
                BUF  NIL
          ) ;_ end of setq
        ) ;_ end of repeat
        (setq RET RET1)
      ) ;_ end of lambda
     )
     (if LST
       (setq RET (cons LST RET))
     ) ;_ end ofif
     (setq LST (reverse RET))
     (setq I 0)
     (mapcar '(lambda (THIS_LIST)
                (if (<= (setq I (1+ I)) COUNT_COL)
                  (progn
                    (start_list (strcat "info" (itoa I)))
                    (mapcar 'add_list THIS_LIST)
                    (end_list)
                  ) ;_ end ofprogn
                ) ;_ end ofif
              ) ;_ end oflambda
             LST
     ) ;_ end ofmapcar

     (set_tile "info1" "0")
     (setq I 0
           NCOL 1
     ) ;_ end ofsetq
     (repeat COUNT_COL
       (action_tile
         (strcat "info" (itoa (setq I (1+ I))))
         (strcat "(progn (setq Ncol "
                 (itoa I)
                 ")(if (not multi)(_loc_clear Ncol))"
                 "(if (and (not multi)(= $reason 4))(_loc_finish)))"
         ) ;_ end ofstrcat
       ) ;_ end ofaction_tile
     ) ;_ end ofrepeat
     (action_tile "cancel" "(done_dialog 0)")
     (action_tile "accept" "(_loc_finish)")
     (if MULTI
       (set_tile "error" "Use CTRL and SHIFT for a choicet") ;_ end ofset_tile
       (set_tile "error" "It is possible to choose double click") ;_ end ofset_tile
     ) ;_ end ofif
     (if (zerop (start_dialog))
       (setq RET NIL)
       (progn
         (setq
           RET (apply
                 'append
                 (mapcar
                   '(lambda (ITM)
                      (setq THIS_LIST (nth (1- (car ITM)) LST))
                      (mapcar
                        (function (lambda (NUM) (nth NUM THIS_LIST)))
                        (read (strcat "(" (cdr ITM) ")"))
                      ) ;_ end ofmapcar
                    ) ;_ end oflambda
                   RET
                 ) ;_ end ofmapcar
               ) ;_ end ofapply
         ) ;_ end ofsetq

       ) ;_ end ofprogn
     ) ;_ end if
     (unload_dialog DCL_ID)
   ) ;_ end of progn
 ) ;_ end of if
 (vl-file-delete FL)
 RET
) ;_ end ofdefun

COLORXLAY - changes xref layer colors

(_colorxref 1 t) ;_change the color of all xref objects in red

(_colorxref 1 nil) ;_change the color of all xref objects in red, except for objects on locked layers

Currently i have a few different xrefs. Is they anyway to change the colour for specific xref instead of all xref?

Thanks

Bumping this again - its seems ACAD 2016 doesn't want to play ball with this code?

I remember getting it working for command line operations used for batch file processing, but typing _colorx now only returns the pop-up dialogue that is not compatible with batch script processes.

Am I on to something or just going senile?

Cheers!

Well.. i'm having no trouble using it on 2016 (this code http://www.cadtutor.net/forum/showthread.php?533-Lisp-colour-change-for-all-layers-and-blocks&p=596584&viewfull=1#post596584 )

Works really great ! What a wonderfull piece of work i was wanting for some time..

I will be looking to change this code to set TRANSPARENCY in stead of colors as well.

will same be a bunch of clicking. Thanks for sharing VVA!

Hans

performed on a 3D bridge model. This is my YOUTUBE demo of it .. enjoy ;-)

edit:

I added these line and it returns me "some lines here" in a paperspace viewport

But i can't seem to find a vla-put variant for viewport color. Anybody have an idea?

https://www.bricsys.com/bricscad/help/en_US/V9/DevRef/source/IDR_LISP_VLR_VLA_VLAX.htm

(progn
(setq ifmodelspace (getvar "tilemode"))  ; halam added 1 for modelspace ; 0 for paperspace
(setq ifinvpmode (getvar "cvport"))   ; halam added if >2 within a viewport
(if (and (= ifmodelspace 0) (> ifinvpmode 2))  ; halam thinks this works
  (print "some lines here")   ; why isn't there a vla-put-vpcolor??
(vla-put-color item col)))   ; not in paperspace viewport 

;278058]New variant (much longer than the previous ) 
;25092016 Roy_43, there is no vla-put- for vplayer
;22092016 halam : the could be re-used for layer transparency, i like the idea but it's a bit harder..

(defun C:COLORXLAY (/ doc col xreflist ret)i
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for item (vla-get-Blocks doc)
     (if (= (vla-get-IsXref item) :vlax-true)
        (setq xreflist (cons (vla-get-name item) xreflist))
       )
   )
 (if xreflist
 (if (and (setq ret (_dwgru-get-user-dcl "Select XREF " (acad_strlsort xreflist) t))
          (setq col (acad_colordlg 7 nil))  ; transparency dialog? 
          )
   (progn
     (setq ret (apply 'strcat (mapcar '(lambda(x)(strcat x "|*,")) ret)))
   (vla-startundomark doc)
   (vlax-for item (vla-get-Layers doc)
     (if (wcmatch (vla-get-name item) ret)
(progn
(setq ifmodelspace (getvar "tilemode"))  ; halam added 1 for modelspace ; 0 for paperspace
(setq ifinvpmode (getvar "cvport"))   ; halam added if >2 within a viewport
(if (and (= ifmodelspace 0) (> ifinvpmode 2))  ; halam thinks this works
 (command "_.vplayer" "color" col (vla-get-name item) "" "")  ; Roy_43, there is no vla-put- for vplayer
(vla-put-color item col)))   ; not in paperspace viewport 


     )
     )
       (vla-endundomark doc)
   )
 ) ;_ end of if
   (alert "No XREF Found")
   )
 (princ)
) ;_ end of defun
;;; ************************************************************************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group ;;; * ;;; * _dwgru-get-user-dcl (Candidate) ;;; * ;;; * Inquiry of value at the user through a dialogue window ;;; * ;;; * ;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA) ;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden ;;; - Processing of several columns ;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)
(defun _DWGRU-GET-USER-DCL (ZAGL        INFO-LIST   MULTI
                           /           FL          RET
                           DCL_ID      MAXROW      MAX_COUNT_COL
                           COUNT_COL   I           LISTBOX_HEIGHT
                           LST         _LOC_FINISH _LOC_CLEAR
                           NCOL
                          )
;|
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without scrolling is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
    [url]http://dwg.ru/f/showthread.php?p=203746#post203746[/url]
* Parameters of a call:
   zagl - heading of a window [string]
   info-list - the list of line values
[List of String]
   multi - t - the plural choice is resolved, nil-is not present

* Returns:
The list of the chosen lines or nil - a cancelling
* the Example
(_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") nil); _-> ("First")  (_dwgru-get-user-dcl " Specify a variant " ' ("First" "Second" "Third") t); _-> ("First"  "Second ")  (_dwgru-get-user-dcl " Specify a variant "
  (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)  (_dwgru-get-user-dcl " Specify a variant, using CTRL and SHIFT for a choice "
  (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Value-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
 (setq MAXROW 40) ;_  max lines without scrolling (To it 3 more lines further will be added)
 (setq MAX_COUNT_COL 5) ; _ a maximum quantity of columns ;;============== Local functions START========================
 (defun _LOC_FINISH ()
   (setq I   0
         RET NIL
   ) ;_ end ofsetq
   (repeat COUNT_COL
     (setq I (1+ I))
     (setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
   ) ;_ end ofrepeat
   (setq RET (reverse RET))
   (done_dialog 1)
 ) ;_ end ofdefun
 (defun _LOC_CLEAR (NOMER)
   (setq I 0)
   (repeat COUNT_COL
     (setq I (1+ I))
     (if (/= I NOMER)
       (progn
         (start_list (strcat "info" (itoa I)))
         (mapcar 'add_list (nth (1- I) LST))
         (end_list)
       ) ;_ end ofprogn
     ) ;_ end ofif
   ) ;_ end ofrepeat
 ) ;_ end ofdefun
;;;==================== Local functions END ==================================
;;;==================== MAIN PART ===============================================
 (if (null ZAGL)(setq ZAGL "Select")) ;_ end if
 (if (zerop (rem (length INFO-LIST) MAXROW))
   (setq COUNT_COL (/ (length INFO-LIST) MAXROW))
   (setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0))))
 ) ;_ end ofif
 (if (> COUNT_COL MAX_COUNT_COL)
   (setq COUNT_COL MAX_COUNT_COL)
 )
 (setq LISTBOX_HEIGHT (+ 3 MAXROW))
  ;_ We add 3 lines for appearance and for exception boundary scroll
 (if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
   (setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
 ) ;_ end ofif
 (setq I 0)
 (setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
 (setq RET (open FL "w")
       LST NIL
 ) ;_ end ofsetq
 (mapcar '(lambda (X) (write-line X RET))
         (append (list "dwgru_get_user : dialog { "
                       (strcat "label=\"" ZAGL "\";")
                       ": boxed_row {"
                       "label = \"Value\";"
                 ) ;_ end oflist
                 (repeat COUNT_COL
                   (setq LST
                          (append
                            LST
                            (list
                              " :list_box {"
                              "alignment=top ;"
                              (if MULTI
                                "multiple_select = true ;"
                                "multiple_select = false ;"
                              ) ;_ end ofif
                              "width=31 ;"
                              (strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
                              "is_tab_stop = false ;"
                              (strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
                            ) ;_ end oflist
                          ) ;_ end ofappend
                   ) ;_ end ofsetq
                 ) ;_ end ofrepeat
                 (list
                   "}"
                   ":row{"
                   "ok_cancel_err;}}"
                 ) ;_ end oflist
         ) ;_ end of list
 ) ;_ end of mapcar
 (setq RET (close RET))
 (if (and (null (minusp (setq DCL_ID (load_dialog FL))))
          (new_dialog "dwgru_get_user" DCL_ID)
     ) ;_ end and
   (progn
     (setq LST INFO-LIST)
     ((lambda (/ RET1 BUF ITM)
        (repeat (1- COUNT_COL)
          (setq I '-1)
          (while (and (setq ITM (car LST))
                      (< (setq I (1+ I)) MAXROW)
                 ) ;_ end of and
            (setq BUF (cons ITM BUF)
                  LST (cdr LST)
            ) ;_ end of setq
          ) ;_ end ofwhile
          (setq RET1 (cons (reverse BUF) RET1)
                BUF  NIL
          ) ;_ end of setq
        ) ;_ end of repeat
        (setq RET RET1)
      ) ;_ end of lambda
     )
     (if LST
       (setq RET (cons LST RET))
     ) ;_ end ofif
     (setq LST (reverse RET))
     (setq I 0)
     (mapcar '(lambda (THIS_LIST)
                (if (<= (setq I (1+ I)) COUNT_COL)
                  (progn
                    (start_list (strcat "info" (itoa I)))
                    (mapcar 'add_list THIS_LIST)
                    (end_list)
                  ) ;_ end ofprogn
                ) ;_ end ofif
              ) ;_ end oflambda
             LST
     ) ;_ end ofmapcar
     (set_tile "info1" "0")
     (setq I 0
           NCOL 1
     ) ;_ end ofsetq
     (repeat COUNT_COL
       (action_tile
         (strcat "info" (itoa (setq I (1+ I))))
         (strcat "(progn (setq Ncol "
                 (itoa I)
                 ")(if (not multi)(_loc_clear Ncol))"
                 "(if (and (not multi)(= $reason 4))(_loc_finish)))"
         ) ;_ end ofstrcat
       ) ;_ end ofaction_tile
     ) ;_ end ofrepeat
     (action_tile "cancel" "(done_dialog 0)")
     (action_tile "accept" "(_loc_finish)")
     (if MULTI
       (set_tile "error" "Use CTRL and SHIFT for a choicet") ;_ end ofset_tile
       (set_tile "error" "It is possible to choose double click") ;_ end ofset_tile
     ) ;_ end ofif
     (if (zerop (start_dialog))
       (setq RET NIL)
       (progn
         (setq
           RET (apply
                 'append
                 (mapcar
                   '(lambda (ITM)
                      (setq THIS_LIST (nth (1- (car ITM)) LST))
                      (mapcar
                        (function (lambda (NUM) (nth NUM THIS_LIST)))
                        (read (strcat "(" (cdr ITM) ")"))
                      ) ;_ end ofmapcar
                    ) ;_ end oflambda
                   RET
                 ) ;_ end ofmapcar
               ) ;_ end ofapply
         ) ;_ end ofsetq
       ) ;_ end ofprogn
     ) ;_ end if
     (unload_dialog DCL_ID)
   ) ;_ end of progn
 ) ;_ end of if
 (vl-file-delete FL)
 RET
) ;_ end ofdefun

@ Hans:

Apart from the visibility overrides, all VP overrides are stored in the extension dictionaries attached to layer objects. For the color an xrecord named "ADSK_XREC_LAYER_COLOR_OVR" is used. There are no "VL" functions available to deal with these overrides. But you can manipulate dictionaries and xrecords through Lisp code. I have written code for VP overrides but I cannot release it as freeware. So you will have to start programming yourself.

See also:

https://www.theswamp.org/index.php?topic=50477.msg556199#msg556199

Thanks for directing me out. I guess this is the point of the 'coca cola' part in programming dwg ;-) .. Will be hanging to being a novice programmer, part draftsman..

In AutoCAD you can probably use the _VPLAYER command. This command is not fully implemented in BricsCAD so the code is untested.

(command "_.vplayer" "_color" col (vla-get-name item) "")

(command "_.vplayer" "color" col (vla-get-name item) "" "")

Just one enter more,..did the job!

I think vla-put-transparency is object transparency, not layer transparency.

Is it the way to change BLCC lisp to include true color selection window?

Hello everyone! I raise the topic because I have an interesting situation. After using ColorA, all the MText from my drawing just disappears. Does anyone have an idea why this is happening? Thanks in advance!