Files
lisp-scr/layerFromColor.lsp
2019-08-30 14:55:32 +02:00

101 lines
2.9 KiB
Common Lisp

;; layerFromColor.lsp
;;
;; Create separate layers for each selected objects different colors.
;;
;; Created by Peter Gyetvai
;; gyetpet@mailbox.org
(defun C:LFC (/ i imax il ss currElem color colorNum allColors newLayer currLayer newElem)
(graphscr)
; ---------------------------------- prompt ---------------------------------- ;
(prompt "\nselect entities to change layer (all): ")
(setq ss (ssget));asks for selection
(setq il (sslength ss));length of selection
(setq allColors nil)
; -------------------------- get colors from objects ------------------------- ;
(setq i 0);counter to zero
(setq imax 1);while variable
(while imax
;(print i)
(setq currElem (entget (ssname ss i) ))
(setq color (assoc 62 currElem))
(setq colorNum (cdr color))
;(print colorNum)
(if (and (not (= colorNum 0)) colorNum)
(progn
(if (not (type allColors))( setq allColors (list colorNum)))
(if (not (member colorNum allColors)) (setq allColors (append allColors (list colorNum))))
)
)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
; ----------------------------- create new layers ---------------------------- ;
(setq i 0);counter to zero
(setq imax 1);while variable
(while imax
;(print i)
(setq color (nth i allColors))
; --- create new layers --- ;
(command "._layer" "_M" color "")
(command "._layer" "_C" color color "")
(print )
(princ "Created layer ")
(princ color)
(print )
;while specific:
(setq i (1+ i));increments i
(if (= i (length allColors)) (setq imax nil));finish function if i equals il
)
; -------------------------------- set layers -------------------------------- ;
(setq i 0);counter to zero
(setq imax 1);while variable
(while imax
;(print i)
(setq currElem (entget (ssname ss i) ))
(setq color (assoc 62 currElem))
(setq colorNum (cdr color))
(if (and (not (= colorNum 0)) colorNum)
(progn
(setq currLayer (assoc 8 currElem))
(setq newLayer (cons 8 (itoa colorNum)))
(setq newElem(subst newLayer currLayer currElem))
(entmod newElem)
)
)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
; --------------------------- set color to bylayer --------------------------- ;
(print )
(command "_.change" ss "" "_P" "_C" "bylayer" "")
; ---------------------------------- finish ---------------------------------- ;
(terpri)
(setq ss nil)
)