Jump to content

Putting each Solid Object in a separate layer with RANDOM color for each layer


ADSK2007

Recommended Posts

Hello to all

 

I have been using a lisp rutine to put each solid object onto a separate layer for exporting to another application. The lisp works great but it assigns only one color to all layers (Color red). Is there a way to apply a random color to each layer? Below is the routine i use to do this.

 

Thank you for your help

 

 
(defun C:l2l (/ a lname b index b1 name n)
(setvar "regenmode" 0)
(setq a (ssget))
(setq lname "3d" )
(setq b 1)
(setq n (sslength a))
(setq index 0)
(repeat n
  (setq b1 (entget (ssname a index)))
  (setq index (1+  index))
  (setq b2 (rtos b 2 0))
  (setq na (strcat lname b2))
  (command "layer" "n" na "" "")
  (command "layer" "s" na "c" 1 "" "s" 0 "")
  (setq c (assoc  8 b1))
  (setq d (cons (car c)na))
   (setq e (subst d c b1))
   (entmod e)
;   (command "change" !b1 "")
;   (command "change" "p" "" "p" "la" na "" "")
  (setq b (1+  b))
  )
  (setvar "regenmode" 1)
)
(defun C:l2lA (/ a lname b index b1 name n)
(setvar "regenmode" 0)
(setq a (ssget))
(setq lname (getstring "\Enter the starting string (A MAXIMUM OF 5 CHARACTERS): "))
(setq b 1)
(setq n (sslength a))
(setq index 0)
(repeat n
  (setq b1 (entget (ssname a index)))
  (setq index (1+  index))
  (setq b2 (rtos b 2 0))
  (setq na (strcat lname b2))
  (command "layer" "n" na "" "")
  (command "layer" "s" na "c" 1 "" "s" 0 "")
  (setq c (assoc  8 b1))
  (setq d (cons (car c)na))
   (setq e (subst d c b1))
   (entmod e)
;   (command "change" !b1 "")
;   (command "change" "p" "" "p" "la" na "" "")
  (setq b (1+  b))
  )
(setvar "regenmode" 1)
)

Link to comment
Share on other sites

Very quickly written:

 

(defun c:Solids2Layers ( / _padzeros a b e i l n p s )
   (setq p "3d")

   (defun _padzeros ( s l )
       (if (< (strlen s) l) (_padzeros (strcat "0" s) l) s)
   )
   (if (setq s (ssget "_:L" '((0 . "*SOLID"))))
       (progn
           (setq
               i (sslength s)
               l (1+ (fix (/ (log i) (log 10))))
               n 0
           )
           (repeat i
               (setq e (entget (ssname s (setq i (1- i)))))
               (entmod
                   (subst
                       (cons  8 (strcat p (_padzeros (itoa (setq n (1+ n))) l)))
                       (assoc 8 e)
                       e
                   )
               )
           )
           (setq n 0)
           (while (setq a (tblnext "LAYER" (null a)))
               (if (wcmatch (setq b (cdr (assoc 2 a))) (strcat p "*"))
                   (entmod
                       (setq b (entget (tblobjname "LAYER" b))
                             b (subst (cons 62 (setq n (1+ (rem n 254)))) (assoc 62 b) b)
                       )
                   )
               )
           )
       )
   )
   (princ)
)

Link to comment
Share on other sites

Hi Lee

 

Thank you for your help. One question. Do I need to use your lisp AFTER i use the L2L routine or your code will also select the solids and put them all in separate layers with different layer names and colors? Also, is the a way you could add your code to the original lisp routine?

 

Thank you again for helping.

 

ADSK

Link to comment
Share on other sites

My code is independent of the code you have posted, it will prompt the user for a selection, move the objects to separate layers, and change the colours of these layers.

 

Lee

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...