[编程交流] 将柔和的颜色更改为altern

(defun c:Pastel2 nil
 (mapcar
   (function
     (lambda ( oc nc )
       (if (setq ss (ssget "_X" (list (cons 62 oc))))
         (
           (lambda ( x )
             (while (setq e (ssname ss (setq x (1+ x))))
               (ColourChange e nc)
             )
           )
           -1
         )
       )
     )
   )
   '(2 4 6)
   '(3 5 1)
 )
 (princ)
)
(defun ColourChange ( ent col / el )
 ;; © Lee Mac 2010
 (entupd
   (cdr
     (assoc -1
       (entmod
         (if (assoc 62 (setq el (entget ent)))
           (subst
             (cons 62 col) (assoc 62 el) el
           )
           (append el (list (cons 62 col)))
         )
       )
     )
   )
 )
)

(defun c:Pastel2 ( / def l )
 ;; © Lee Mac 2010
 (while (setq def (tblnext "LAYER" (not def)))
   (setq l
     (cons
       (cons (abs (cdr (assoc 62 def))) (cdr (assoc 2 def))) l
     )
   )
 )
 
 (mapcar
   (function
     (lambda ( oc nc / a )
       (if (setq ss
             (ssget "_X"
               (if (setq a (LM:mAssoc oc l))
                 (list
                   (cons -4 "<OR")
                     (cons 62 oc)
                     (cons 8 (LM:lst->str (mapcar 'cdr a) ","))
                   (cons -4 "OR>")
                 )
                 (list (cons 62 oc))
               )
             )
           )
         (
           (lambda ( x )
             (while (setq e (ssname ss (setq x (1+ x))))
               (LM:ColourChange e nc)
             )
           )
           -1
         )
       )
     )
   )
   '(2 4 6)
   '(3 5 1)
 )
 (princ)
)
(defun LM:ColourChange ( ent col / el )
 ;; © Lee Mac 2010
 (entupd
   (cdr
     (assoc -1
       (entmod
         (if (assoc 62 (setq el (entget ent)))
           (subst
             (cons 62 col) (assoc 62 el) el
           )
           (append el (list (cons 62 col)))
         )
       )
     )
   )
 )
)
(defun LM:lst->str ( lst del )
 ;; © Lee Mac 2010
 (if (cdr lst)
   (strcat (car lst) del (LM:lst->str (cdr lst) del))
   (car lst)
 )
)
(defun LM:mAssoc ( x lst )
 ;; © Lee Mac 2010
 (vl-remove-if-not
   (function
     (lambda ( pair ) (= x (car pair)))
   )
   lst
 )
)

(defun c:bust ()
;(setvar "qaflags" 1)
(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
(while (/= AllBlocks nil)
(progn
(sssetfirst nil AllBlocks)
(c:burst)
(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-SendCommand doc (chr 27))
);progn
);while
(princ)
);defun

(defun c:Pastel3 ( / col def a )
 ;; © Lee Mac 2010
 (setq col '((2 . 3) (4 . 5) (6 . 1)))
 (while (setq def (tblnext "LAYER" (not def)))
   (if (setq a (assoc (abs (cdr (assoc 62 def))) col))
     (LM:ColourChange (tblobjname "LAYER" (cdr (assoc 2 def))) (cdr a))
   )
 )
 (mapcar
   (function
     (lambda ( entry / ss )
       (if (setq ss (ssget "_X" (list (cons 62 (car entry)))))
         (
           (lambda ( x / e )
             (while (setq e (ssname ss (setq x (1+ x))))
               (LM:ColourChange e (cdr entry))
             )
           )
           -1
         )
       )
     )
   )
   col
 )
 (princ)
)
(defun LM:ColourChange ( ent col / el )
 ;; © Lee Mac 2010
 (entupd
   (cdr
     (assoc -1
       (entmod
         (if (assoc 62 (setq el (entget ent)))
           (subst
             (cons 62 col) (assoc 62 el) el
           )
           (append el (list (cons 62 col)))
         )
       )
     )
   )
 )
)