Assigning random colors to each line/polyline within a selection set

[enthralled]

Hello,

I have hundreds of lines and LW polylines and I need to color differentiate them, is there a way to give a random color to each line/polyline within a selection set?

 

[exceed]

(defun c:ordercolor ( / *error* sel scolor selcount selnum selname sellist check )
 (setvar "cmdecho" 0) 
 (setq sel (ssget '((0 . "*LINE"))))

 (command "_undo" "_be")
   (defun *error*(e)
     (command "_undo" "_e")
     (princ)
   )
 (setq scolor 0)
 (setq selcount (sslength sel)) 
 (setq selnum 0) 

(repeat selcount 
    (setq selname (ssname sel selnum))
    (setq sellist (vlax-ename->vla-object selname))
    (setq check (vlax-property-available-p sellist "Color" T))
	(if check
		(vlax-put-property sellist 'Color scolor)
	)
    (setq selnum (+ selnum 1))
    (setq scolor (+ scolor 1))
    
    (if (> scolor 255) (setq scolor 0))
)

(command "_undo" "_e")
);end_defun



(defun c:randomcolor ( / *error* sel scolor selcount selnum selname sellist check )
 (setvar "cmdecho" 0) 
 (setq sel (ssget '((0 . "*LINE"))))

 (command "_undo" "_be")
   (defun *error*(e)
     (command "_undo" "_e")
     (princ)
   )
 (setq scolor 0)
 (setq selcount (sslength sel)) 
 (setq selnum 0) 

(repeat selcount 
    (setq selname (ssname sel selnum))
    (setq sellist (vlax-ename->vla-object selname))
    (setq check (vlax-property-available-p sellist "Color" T))
	(if check
		(vlax-put-property sellist 'Color scolor)
	)
    (setq selnum (+ selnum 1))
    (setq scolor (LM:randrange 0 255))
)

(command "_undo" "_e")
);end_defun




;; Random in Range  -  Lee Mac
;; Returns a pseudo-random integral number in a given range (inclusive)

(defun LM:randrange ( a b )
    (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b))))))
)



;; Rand  -  Lee Mac
;; PRNG implementing a linear congruential generator with
;; parameters derived from the book 'Numerical Recipes'

(defun LM:rand ( / a c m )
    (setq m   4294967296.0
          a   1664525.0
          c   1013904223.0
          $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
    )
    (/ $xn m)
)

 

RANDOMCOLOR to set random (0 to 255)

ORDERCOLOR to set order (0 to 255)  it changes according to the order of ssget.

Edited January 10, 2022 by exceed

[enthralled]

14 minutes ago, exceed said:

(defun c:ordercolor ( / *error* sel scolor selcount selnum selname sellist check )
 (setvar "cmdecho" 0) 
 (setq sel (ssget '((0 . "*LINE"))))

 (command "_undo" "_be")
   (defun *error*(e)
     (command "_undo" "_e")
     (princ)
   )
 (setq scolor 0)
 (setq selcount (sslength sel)) 
 (setq selnum 0) 

(repeat selcount 
    (setq selname (ssname sel selnum))
    (setq sellist (vlax-ename->vla-object selname))
    (setq check (vlax-property-available-p sellist "Color" T))
	(if check
		(vlax-put-property sellist 'Color scolor)
	)
    (setq selnum (+ selnum 1))
    (setq scolor (+ scolor 1))
    
    (if (> scolor 255) (setq scolor 0))
)

(command "_undo" "_e")
);end_defun



(defun c:randomcolor ( / *error* sel scolor selcount selnum selname sellist check )
 (setvar "cmdecho" 0) 
 (setq sel (ssget '((0 . "*LINE"))))

 (command "_undo" "_be")
   (defun *error*(e)
     (command "_undo" "_e")
     (princ)
   )
 (setq scolor 0)
 (setq selcount (sslength sel)) 
 (setq selnum 0) 

(repeat selcount 
    (setq selname (ssname sel selnum))
    (setq sellist (vlax-ename->vla-object selname))
    (setq check (vlax-property-available-p sellist "Color" T))
	(if check
		(vlax-put-property sellist 'Color scolor)
	)
    (setq selnum (+ selnum 1))
    (setq scolor (LM:randrange 0 255))
)

(command "_undo" "_e")
);end_defun




;; Random in Range  -  Lee Mac
;; Returns a pseudo-random integral number in a given range (inclusive)

(defun LM:randrange ( a b )
    (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b))))))
)



;; Rand  -  Lee Mac
;; PRNG implementing a linear congruential generator with
;; parameters derived from the book 'Numerical Recipes'

(defun LM:rand ( / a c m )
    (setq m   4294967296.0
          a   1664525.0
          c   1013904223.0
          $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
    )
    (/ $xn m)
)

 

RANDOMCOLOR to set random (0 to 255)

ORDERCOLOR to set order (0 to 255)  it changes according to the order of ssget.

Thanks. This helps me a lot!

[samifox]

that great lisp. Instead of 1-255 i want to provide a list of numbers to randomize. 

how to do it?

[marko_ribar]

(defun c:randlstcolcurv ( / *error* LM:randrange LM:rand cad doc alo spc collst sel i e o col )

  (or (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil)) (vl-load-com))

  (defun *error* ( m )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if doc
        (vla-endundomark doc)
      )
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  ;; Random in Range  -  Lee Mac
  ;; Returns a pseudo-random integral number in a given range (inclusive)

  (defun LM:randrange ( a b )
      (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b))))))
  )

  ;; Rand  -  Lee Mac
  ;; PRNG implementing a linear congruential generator with
  ;; parameters derived from the book 'Numerical Recipes'

  (defun LM:rand ( / a c m )
      (setq m   4294967296.0
            a   1664525.0
            c   1013904223.0
            $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
      )
      (/ $xn m)
  )

  (or cad (setq cad (vlax-get-acad-object)))
  (or doc (setq doc (vla-get-activedocument cad)))
  (or alo (setq alo (vla-get-activelayout doc)))
  (or spc (setq spc (vla-get-block alo)))
  (if doc
    (vla-startundomark doc)
  )
  (setq collst (list 1 5 8 9 15 25 31 24 52 64 85 93 72)) ;;; edit to suit your needs ;;;
  (if (setq sel (ssget (list (cons 0 "*LINE"))))
    (repeat (setq i (sslength sel))
      (setq e (ssname sel (setq i (1- i))))
      (setq o (vlax-ename->vla-object e))
      (if (vlax-property-available-p o "Color" T)
        (progn
          (setq col (nth (LM:randrange 0 (1- (length collst))) collst))
          (vlax-put-property o (quote color) col)
        )
      )
    )
  )
  (*error* nil)
)

 

 

HTH.

M.R.

Edited Sunday at 06:57 AM by marko_ribar