In Acad2010 the command LayISO & LayUnISO , seems runing too slow , perhaps it light all objects colors .
I writte one to light objects colors except ref-objects & color-not-bylayer's objects . and this , it'll run fast .
;;LayerISO & LayerunISO
;;color fade scale , 0~90 , fitable 50~75 .
(setq #gsls_color_fade# 75)
;;
(defun c:myLayISO (/ *error* om oc oe ss lst ssen la)
;;by GSLS(SS) 2011-09-16
(setq om (getvar "MODEMACRO")
oc (getvar "cmdecho")
oe *error*
)
(defun *error* (msg)
(command)
(command)
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ msg)
(princ (strcat "\n错误: " msg))
)
(setvar "MODEMACRO" om)
(setvar "cmdecho" oc)
(setq *error* oe)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(setvar "MODEMACRO" "选择要隔离的图层上的对象:")
(setvar "cmdecho" 0)
(setq ss (ssget))
(if ss
(progn
(setq ssen (ss2lst ss nil))
(foreach a ssen
(if (not (member (setq la (dxf 8 (entget a))) lst))
(setq lst (cons la lst))
)
)
(ss:layer:iso lst)
)
(princ "\n未选择对象，请重新执行命令.")
)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setvar "MODEMACRO" om)
(setvar "cmdecho" oc)
(setq *error* oe)
(princ)
)
;;
(defun c:myLayUnISO (/ *error* oc oe)
;;by GSLS(SS) 2011-09-16
(setq oc (getvar "cmdecho")
oe *error*
)
(defun *error* (msg)
(command)
(command)
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ msg)
(princ (strcat "\n错误: " msg))
)
(setvar "cmdecho" oc)
(setq *error* oe)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(ss:layer:uniso)
(ss:layer:on)
(vla-EndUndoMark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setvar "cmdecho" oc)
(setq *error* oe)
(princ)
)
;;;
(defun ss:layer:ISO (l / las ent col lay tc)
(setq las (xyp-get-tblnext "LAYER"))
(while las
(setq lay (car las)
las (cdr las)
ent (entget (TblObjName "layer" lay))
)
(if (and (not (member lay l))
(/= (logand 1 (dxf 70 ent)) 1)
(/= (logand 2 (dxf 70 ent)) 2)
)
(progn (setq col (dxf 62 ent)
tc (dxf 420 ent)
)
(vlax-ldata-put "date" lay (list col tc))
(if tc
(setq col (ss:color:true:fade tc))
(setq col (ss:color:aci:fade col))
)
(Entmod
(ch-en (cons 420 col) (subst (cons 70 4) (cons 70 0) ent))
)
)
)
)
)
;;;
(defun ss:layer:uniso (/ las lay ent col tc)
(setq las (xyp-get-tblnext "LAYER"))
(while las
(setq lay (car las)
las (cdr las)
ent (entget (TblObjName "layer" lay))
)
(if (= (logand 4 (dxf 70 ent)) 4)
(progn (if (and (setq col (vlax-ldata-get "date" lay)) (setq tc (cadr col)))
(setq ent (ch-en (cons 62 (car col)) (ch-en (cons 420 tc) ent)))
(setq ent (ch-en (cons 62 (car col)) (vl-remove (assoc 420 ent) ent)))
)
(setq ent (ch-en (cons 70 0) ent))
(vlax-ldata-delete "date" lay)
(Entmod ent)
)
)
)
)
;;;
(defun ss:layer:on (/ las lay ent col)
(setq las (xyp-get-tblnext "LAYER"))
(foreach lay las
(setq ent (entget (TblObjName "layer" lay)))
(if (or (= (logand 1 (dxf 70 ent)) 1) (= (logand 2 (dxf 70 ent)) 2))
(princ (strcat "\n图层" lay "处于冻结状态**"))
(if (< (setq col (dxf 62 ent)) 0)
(progn
(entmod (ch-en (cons 62 (- col)) ent))
(princ (strcat "\n图层" lay "已打开。"))
)
)
)
)
)
;;;
(defun xyp-get-tblnext (table-name / lst d)
;;by xyp1964
(while (setq d (tblnext table-name (null d)))
(setq lst (cons (dxf 2 d) lst))
)
(reverse lst)
)
;;
(defun dxf (co en)
(if(eq(type en)(quote ENAME))(setq en(entget en(quote("*")))))
(if(vl-consp co)(mapcar (function (lambda (x)(cdr (assoc x en))))co)
(cdr (assoc co en))))
;;
(defun ch-en (co en /)
(if (eq (type en) (quote ename))
(setq en (entget en (list "*")))
)
(if (assoc (car co) en)
(subst co (assoc (car co) en) en)
(append en (list co))
)
)
;;
;;; aci fade -> true
(defun ss:color:aci:fade (c / r h )
;;by GSLS(SS)
;;key fun ...
(setq r (lm:aci->rgb c))
(setq h (apply (function lm:rgb->hsl ) r)
h (append (butlast h) (list (fix (round (* (last h) (- 100 #gsls_color_fade#) 0.01) 0))))
)
(apply (function lm:rgb->true) (apply (function lm:hsl->rgb ) h))
)
;;; true fade -> true
(defun ss:color:true:fade (c / r h )
;;by GSLS(SS)
;;key fun ...
(setq r (lm:true->rgb c))
(setq h (apply (function lm:rgb->hsl ) r)
h (append (butlast h) (list (fix (round (* (last h) (- 100 #gsls_color_fade#) 0.01) 0))))
)
(apply (function lm:rgb->true) (apply (function lm:hsl->rgb ) h))
)
;;
(defun butlast(a)
(reverse (cdr(reverse a)))
)
;;
(defun ss2lst (ss vla / a e i)
(if (= (type ss) (quote PICKSET))
(progn
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if vla
(setq e (vlax-ename->vla-object e))
nil
)
(setq a (cons e a))
)
)
nil
)
)
;;
(defun round (a jd / b)
(setq b (expt 10.0 jd))
(/ (fix (+ (* a b) 0.5)) b)
)
;;-----------------------------------
;;following codes written by LeeMac
;;copy from
;; http://www.lee-mac.com/colourconversion.html
;;
;; True -> RGB - Lee Mac 2011
;; Args: c - True Colour
(defun LM:True->RGB ( c )
(list
(lsh (lsh (fix c) 8) -24)
(lsh (lsh (fix c) 16) -24)
(lsh (lsh (fix c) 24) -24)
)
)
;; RGB -> True - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values
(defun LM:RGB->True ( r g b )
(+
(lsh (fix r) 16)
(lsh (fix g) 8)
(fix b)
)
)
;; OLE -> True - Lee Mac 2011
;; Args: c - OLE Colour
(defun LM:OLE->True ( c )
(+
(lsh (lsh (lsh (fix c) 24) -24) 16)
(lsh (lsh (lsh (fix c) 16) -24) 8)
(lsh (lsh (fix c) 8) -24)
)
)
;; True -> OLE - Lee Mac 2011
;; Args: c - True Colour
(defun LM:True->OLE ( c )
(+
(lsh (lsh (fix c) 8) -24)
(lsh (lsh (lsh (fix c) 16) -24) 8)
(lsh (lsh (lsh (fix c) 24) -24) 16)
)
)
;; RGB -> HSL - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values
(defun LM:RGB->HSL ( r g b / _round d h l m n s )
(setq r (/ r 255.)
g (/ g 255.)
b (/ b 255.)
n (min r g b)
m (max r g b)
d (- m n)
l (/ (+ m n) 2.)
)
(defun _round ( n )
(fix (+ n (if (minusp n) -0.5 0.5)))
)
(mapcar '_round
(cond
( (zerop d)
(list 0 0 (* m 100))
)
(t
(setq s (if (< l 0.5) (/ d (+ m n)) (/ d (- 2. m n))))
(setq h
(cond
( (= g m) (+ (/ (- b r) d) 2))
( (= b m) (+ (/ (- r g) d) 4))
( (/ (- g b) d))
)
)
(list (rem (+ 360 (* h 60)) 360) (* s 100) (* l 100))
)
)
)
)
;; HSL -> RGB - Lee Mac 2011
;; Args: 0 <= h <= 360, 0 <= s,l <= 100
(defun LM:HSL->RGB ( h s l / _sub _round u v )
(setq h (/ h 360.)
s (/ s 100.)
l (/ l 100.)
)
(defun _sub ( u v h )
(setq h (rem (1+ h) 1))
(cond
( (< (* 6 h) 1) (+ u (* 6 h (- v u))))
( (< (* 2 h) 1) v)
( (< (* 3 h) 2) (+ u (* 6 (- (/ 2. 3.) h) (- v u))))
( u )
)
)
(defun _round ( n )
(fix (+ n (if (minusp n) -0.5 0.5)))
)
(mapcar '_round
(mapcar '* '(255 255 255)
(cond
( (zerop s)
(list l l l)
)
( (zerop l)
'(0 0 0)
)
(t
(setq v (if (< l 0.5) (* l (1+ s)) (- (+ l s) (* l s)))
u (- (* 2 l) v)
)
(mapcar '(lambda ( h ) (_sub u v h)) (list (+ h (/ 1. 3.)) h (- h (/ 1. 3.))))
)
)
)
)
)
;; True -> ACI - Lee Mac 2011
;; Args: c - True Colour
(defun LM:True->ACI ( c / cObj aci ) (vl-load-com)
(if
(and
(setq cObj
(vla-getInterfaceObject (vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
)
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-SetRGB (cons cObj (LM:True->RGB c)))
)
)
)
(setq aci (vla-get-ColorIndex cObj))
)
(if cObj (vlax-release-object cObj))
aci
)
;; ACI -> True - Lee Mac 2011
;; Args: c - ACI (AutoCAD Colour Index) Colour
(defun LM:ACI->True ( c / cObj tc ) (vl-load-com)
(if
(and (<= 1 c 255)
(setq cObj
(vla-getInterfaceObject (vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
)
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-put-ColorIndex (list cObj c))
)
)
)
(setq tc (LM:RGB->True (vla-get-Red cObj) (vla-get-Green cObj) (vla-get-Blue cObj)))
)
(if cObj (vlax-release-object cObj))
tc
)
;; ACI -> RGB - Lee Mac 2011
;; Args: c - ACI (AutoCAD Colour Index) Colour
(defun LM:ACI->RGB ( c / cObj rgb ) (vl-load-com)
(if
(and (<= 1 c 255)
(setq cObj
(vla-getInterfaceObject (vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
)
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-put-ColorIndex (list cObj c))
)
)
)
(setq rgb (list (vla-get-Red cObj) (vla-get-Green cObj) (vla-get-Blue cObj)))
)
(if cObj (vlax-release-object cObj))
rgb
)
;; RGB -> ACI - Lee Mac 2011
;; Args: r,g,b - Red,Green,Blue values
(defun LM:RGB->ACI ( r g b / cObj aci ) (vl-load-com)
(if
(and
(setq cObj
(vla-getInterfaceObject (vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (substr (getvar 'ACADVER) 1 2))
)
)
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-SetRGB (list cObj r g b))
)
)
)
(setq aci (vla-get-ColorIndex cObj))
)
(if cObj (vlax-release-object cObj))
aci
)
