LISP to change layer colors to random colors

[mtubbs]

I am in need of a Lisp routine that will create a selection set of a large group of layers with a specific layer name (PP-*). Then take that set of layers and change the color of each of those layers to a different random color in Autocad. I will have thousands of layers, so I wanted to avoid singling out each layer individually; that would take forever, and make a huge Lisp or Script.

[tyshofner]

Do you want each (PP-*) layer to be a different color, or all (PP-*) layers changed to a single color?

The following will do the second option:

(defun C:TEST ( / clr lay_col lay_nm lay)
(vl-load-com)
(initget 1)
(setq clr (getint "\nSpecify layer color number: "))
(setq lay_col (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) ;get layer collection
(vlax-for lay lay_col ;Iterate through layers
	(setq lay_nm (vla-get-name lay)) ;find the name
	(if (= (substr lay_nm 1 3) "PP-") ;check if first three characters = "PP-"
	 (vla-put-color lay clr) ;Recolor if "PP-"
	) ;end_if
	(vlax-release-object lay) ;Release layer object
) ;end_vlax-for
(vlax-release-object lay_col) ;release layer collection object
(princ) ;clear command line
) ;end_defun

Ty

[mtubbs]

In reponse to: "Do you want each (PP-*) layer to be a different color, or all (PP-*) layers changed to a single color?"

I need each (PP-*) layer to be a different color. I could easily write a script routine for the latter. I am looking for a way for AutoCAD to random cycle through the selection set and assign each layer a different (independent) color. I am looking for a way to avoid writing an insanely huge script.

[fixo]

In reponse to: "Do you want each (PP-*) layer to be a different color, or all (PP-*) layers changed to a single color?"

I need each (PP-*) layer to be a different color. I could easily write a script routine for the latter. I am looking for a way for AutoCAD to random cycle through the selection set and assign each layer a different (independent) color. I am looking for a way to avoid writing an insanely huge script.

Here is a quick lisp to do it
Give this a shot

~'J'~

;;local functions:

; by Paul Kohut
(setq SeedRand 1)
(defun rand (/)
  (setq SeedRand (+ (* (fix SeedRand) 214013) 2531011))
  (boole 1 (/ SeedRand 65536) 32767)
)

; edited by Fatty
(defun randomgen (num init / rlst SeedRand init ncount val)

  (setq SeedRand (abs (fix (* 128256 (- init (fix init))))))
  (setq nCount 0)
  (while (< nCount num)
        (setq val (rem (rand) num))
    (if (not (member val rlst))
      (progn
 (setq rlst (cons val rlst))
 (setq nCount (+ nCount 1))
      )
    )
  )
  rlst
  )
(defun check-layer (name color)
    (or
      (tblsearch "layer" name)
      (entmake
        (list
          '(0 . "LAYER")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbLayerTableRecord")
          '(70 . 0)
          (cons 2 name)
          (cons 62 color))))
)
;main 
(defun c:MBL (/ colors data i lnames makelist)
(princ "\n\t >> Layers to create >>")
(setq lnames (list "PP-100A"
		   "PP-100B"
		   "PP-100C"
		   "PP-100D"
		   "PP-100E"
		   "PP-100F"
		   "PP-100G"
		   "PP-100H"
		   "PP-100ETC"))
(prin1 lnames)
(setq data (randomgen 200 255))
(setq i 0)
(while (< i (length lnames))
  (setq colors (cons (car data) colors))
  (setq data (cdr data))
  (setq i (1+ i)))
(princ "\n\t >> Randomly generated colors >>")  
(prin1 colors)
(setq makelist (mapcar 'cons lnames colors))
  (foreach item makelist
    (check-layer (car item) (cdr item))
    )
  (princ)
  )
(princ "\n\t >> Type MBL to create layers >>")
(princ)

[kennet.sjoberg]

. . .I am looking for a way for AutoCAD to random cycle through the selection set and assign each layer a different (independent) color. . . .

. . .one more way

(defun C:RLC ;| RandomLayerColor |; ( / LayDxf random modulus multiplier increment ) ;; *seed* is a global random variable
  (if (not *seed* ) (setq *seed* (getvar "DATE" )) )
  (setq LayDxf (tblnext "LAYER" T ) ) ;; take the very first layer
  (while LayDxf ;; repeat as many times as needed
    (if (= (substr (cdr (assoc 2 LayDxf )) 1 3 ) "PP-" ) ;; check if "PP-" is the layer prefix
      (progn
        (setq LayDxf (entget (tblobjname "LAYER" (cdr (assoc 2 LayDxf )))) ) ;; reread the layer dxf from the layer Entity
        (setq LayDxf ;; and substitute the color to a random color
          (subst
            (cons
              62
              (fix (+ 0.5 (setq random (+ (* (setq modulus 65536 multiplier 25173 increment 13849 *seed* (rem (+ (* multiplier *seed* ) increment ) modulus ) random (/ *seed* modulus ) ) 254) 1 ))) )
            )
            (assoc 62 LayDxf )
            LayDxf
          )
        )
        (entmod LayDxf ) ;; update the layer
        (princ (strcat "\nLayer " (cdr (assoc 2 LayDxf )) " changed to color " (itoa (cdr (assoc 62 LayDxf )))) ) ;; you can remove this line
      )
      ( ) ;; the layer prefix was not "PP-"
    )
    (setq LayDxf (tblnext "LAYER" nil ) ) ;; prepare for the next layer
  )
  (princ) ;; silence end
)

: ) Happy Computing !

kennet

[Terry Cadd]

I created the GenLayers function for testing purposes per this thread.
You may find the GetRnd function valuable for other applications as well.

;-------------------------------------------------------------------------------
; GenLayers - Generate 260 PP-* layers of color white to test functions
;-------------------------------------------------------------------------------
(defun c:GenLayers (/ Cnt# LayerName$)
  (setq Cnt# 1)
  (repeat 260
    (setq LayerName$ (strcat "PP-" (substr (itoa (+ 1000 Cnt#)) 2)))
    (command "LAYER" "M" LayerName$ "C" 7 "" "")
    (setq Cnt# (1+ Cnt#))
  );repeat
  (princ)
);defun c:GenLayers
;-------------------------------------------------------------------------------
; LayerRnd - Changes colors of layers PP-* to random colors using all 255 colors
;-------------------------------------------------------------------------------
(defun c:LayerRnd (/ Color# ColorList@ LayerList@ LayerName$ Loop)
  (setq LayerList@ (tblnext "LAYER" t))
  (while LayerList@
    (setq LayerList@ (entget (tblobjname "LAYER" (cdr (assoc 2 LayerList@)))))
    (setq LayerName$ (cdr (assoc 2 LayerList@)))
    (if (= (substr LayerName$ 1 3) "PP-")
      (progn
        (setq Loop t)
        (while Loop
          (setq Color# (1+ (GetRnd 254)));Colors 1-255
          (if (not (member Color# ColorList@))
            (setq Loop nil ColorList@ (append ColorList@ (list Color#)))
          );if
        );while
        (if (= (length ColorList@) 255)
          (progn
            (setq ColorList@ nil)
            (alert "255 random colors have been created\nfor the PP-* layers. Starting over again.")
          );progn
        );if
        (entmod (subst (cons 62 Color#) (assoc 62 LayerList@) LayerList@))
      );progn
    );if
    (setq LayerList@ (tblnext "LAYER"))
  );while
  (princ)
);defun c:LayerRnd
;-------------------------------------------------------------------------------
; GetRnd - Generates a random number
; Arguments: 1
;   Num# = Maximum random number range
; Returns: Random integer number between 0 and Num#.
;-------------------------------------------------------------------------------
(defun GetRnd (Num# / MaxNum# PiDate$ RndNum# Minus Loop)
  (if (or (/= (type Num#) 'INT)(= Num# 0))
    (progn
      (princ "\nSyntax: (GetRnd Num#) Num# = Maximum random integer number range\ngreater than or less than 0.")
      (exit)
    );progn
  );if
  (if (< Num# 0)
    (setq MaxNum# (abs (1- Num#)) Minus t)
    (setq MaxNum# (1+ Num#))
  );if
  (if (not *RndNum*) (setq *RndNum* 10000))
  (setq Loop t)
  (while Loop
    (if (or (null *int*)(> *int* 100))
      (setq *int* 1)
      (setq *int* (1+ *int*))
    );if
    (setq PiDate$ (rtos (* (getvar "cdate") (* pi *int*)) 2 8))
    (cond
      ((>= MaxNum# 10000)
        (setq RndNum# (fix (* (atof (substr PiDate$ 13 5)) (* MaxNum# 0.00001))))
      )
      ((>= MaxNum# 1000)
        (setq RndNum# (fix (* (atof (substr PiDate$ 14 4)) (* MaxNum# 0.0001))))
      )
      ((>= MaxNum# 100)
        (setq RndNum# (fix (* (atof (substr PiDate$ 15 3)) (* MaxNum# 0.001))))
      )
      ((>= MaxNum# 10)
        (setq RndNum# (fix (* (atof (substr PiDate$ 16 2)) (* MaxNum# 0.01))))
      )
      ((>= MaxNum# 1)
        (setq RndNum# (fix (* (atof (substr PiDate$ 17 1)) (* MaxNum# 0.1))))
      )
      (t (setq RndNum# 0))
    );cond
    (if (/= RndNum# *RndNum*)
      (setq Loop nil)
    );if
  );while
  (setq *RndNum* RndNum#)
  (if Minus
    (setq RndNum# (* RndNum# -1))
  );if
  RndNum#
);defun GetRnd
;-------------------------------------------------------------------------------

[tany0070]

try this:

(setq s1 (ssget "X" '((8 . "layer name"))))
(command "change" s1 "" "p" "c" (color code) "")

repeat this for all the layers you want to color change, the color code can be obtain in the color option in autoCAD.

[kennet.sjoberg]

try this: . . . (setq s1 (ssget "X" '((8 . "layer name")))) . . .

We are talking layers not objects, you can not ssget a layer.

: ) Happy Computing !

kennet

[mtubbs]

Thanks "kennet.sjoberg" and "Terry Cad"! Both of your Lisps work flawlessly with the same result. Now I have to figure out which to use!

[tany0070]

We are talking layers not objects, you can not ssget a layer.

: ) Happy Computing !

kennet

oh my bad sorry.