Colour Conversion Functions

sachindkini · 发表于 2013-6-7 21:20:14

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 sachindkini 于 2013-6-7 21:32 编辑

Colour Conversion Functions

Here I present a collection of functions to convert between various colour enumerations, such as RGB Colour, HSL Colour, OLE Colour, True Colour & ACI Colour (AutoCAD Index Colour).

Information about each subfunction and its required arguments is detailed in the function headers. Note that conversion to ACI will yield an approximation to the supplied colour.

RGB & OLE

;; RGB -> OLE - Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values
(defun LM:RGB->OLE ( r g b )
(+ (fix r)
(lsh (fix g) 08)
(lsh (fix b) 16)
)
)
;; OLE -> RGB - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->RGB ( c )
(list
(lsh (lsh (fix c) 24) -24)
(lsh (lsh (fix c) 16) -24)
(lsh (lsh (fix c) 08) -24)
)
)

RGB & True

;; RGB -> True - Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values
(defun LM:RGB->True ( r g b )
(+ (lsh (fix r) 16)
(lsh (fix g) 08)
(fix b)
)
)
;; True -> RGB - Lee Mac
;; Args: c - [int] True Colour
(defun LM:True->RGB ( c )
(list
(lsh (lsh (fix c) 08) -24)
(lsh (lsh (fix c) 16) -24)
(lsh (lsh (fix c) 24) -24)
)
)

RGB & ACI

;; RGB -> ACI - Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values
(defun LM:RGB->ACI ( r g b / o r )
(if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
(progn
(vl-catch-all-apply
'(lambda ( )
(vla-setrgb o r g b)
(setq r (vla-get-colorindex o))
)
)
(vlax-release-object o)
r
)
)
)
;; ACI -> RGB - Lee Mac
;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255)
(defun LM:ACI->RGB ( c / o r )
(if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
(progn
(vl-catch-all-apply
'(lambda ( )
(vla-put-colorindex (list o c))
(setq r (list (vla-get-red o) (vla-get-green o) (vla-get-blue o)))
)
)
(vlax-release-object o)
r
)
)
)
;; Application Object - Lee Mac
;; Returns the VLA Application Object
(defun LM:acapp nil
(eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
(LM:acapp)
)

;; RGB -> ACI  -  Lee Mac 
;; Args: r,g,b - [int] Red, Green, Blue values 
 
(defun LM:RGB->ACI ( r g b / o r ) 
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) 
        (progn 
            (vl-catch-all-apply 
               '(lambda ( ) 
                    (vla-setrgb o r g b) 
                    (setq r (vla-get-colorindex o)) 
                ) 
            ) 
            (vlax-release-object o) 
            r 
        ) 
    ) 
) 
 
;; ACI -> RGB  -  Lee Mac 
;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255) 
 
(defun LM:ACI->RGB ( c / o r ) 
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) 
        (progn 
            (vl-catch-all-apply 
               '(lambda ( ) 
                    (vla-put-colorindex (list o c)) 
                    (setq r (list (vla-get-red o) (vla-get-green o) (vla-get-blue o))) 
                ) 
            ) 
            (vlax-release-object o) 
            r 
        ) 
    ) 
) 
 
;; Application Object  -  Lee Mac 
;; Returns the VLA Application Object 
 
(defun LM:acapp nil 
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object))) 
    (LM:acapp) 
)

RGB & HSL

;; RGB -> HSL - Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values
(defun LM:RGB->HSL ( r g b / d h l m n s )
(setq r (/ r 255.0)
g (/ g 255.0)
b (/ b 255.0)
n (min r g b)
m (max r g b)
)
(if (zerop (setq d (- m n)))
(list 0 0 (fix (+ 0.5 (* m 100))))
(progn
(if (< (setq l (/ (+ m n) 2.0)) 0.5)
(setq s (/ d (+ m n)))
(setq s (/ d (- 2.0 m n)))
)
(cond
( (= g m) (setq h (+ (/ (- b r) d) 2)))
( (= b m) (setq h (+ (/ (- r g) d) 4)))
( (setq h (/ (- g b) d)))
)
(list
(fix (+ 0.5 (rem (+ 360 (* h 60)) 360)))
(fix (+ 0.5 (* s 100)))
(fix (+ 0.5 (* l 100)))
)
)
)
)
;; HSL -> RGB - Lee Mac
;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100
(defun LM:HSL->RGB ( h s l / u v )
(setq h (/ h 360.0)
s (/ s 100.0)
l (/ l 100.0)
)
(cond
( (zerop s)
(setq l (fix (+ 0.5 (* 255.0 l))))
(list l l l)
)
( (zerop l)
'(0 0 0)
)
( (if (< l 0.5)
(setq v (* l (1+ s)))
(setq v (- (+ l s) (* l s)))
)
(setq u (- (* 2.0 l) v))
(mapcar
(function
(lambda ( h )
(setq h (rem (1+ h) 1))
(cond
( (< (* 6.0 h) 1.0)
(fix (+ 0.5 (* 255.0 (+ u (* 6.0 h (- v u))))))
)
( (< (* 2.0 h) 1.0)
(fix (+ 0.5 (* 255.0 v)))
)
( (< (* 3.0 h) 2.0)
(fix (+ 0.5 (* 255.0 (+ u (* 6.0 (- (/ 2.0 3.0) h) (- v u))))))
)
( (fix (+ 0.5 (* 255.0 u))))
)
)
)
(list (+ h (/ 1.0 3.0)) h (- h (/ 1.0 3.0)))
)
)
)
)

;; RGB -> HSL  -  Lee Mac 
;; Args: r,g,b - [int] Red, Green, Blue values 
 
(defun LM:RGB->HSL ( r g b / d h l m n s ) 
    (setq r (/ r 255.0) 
          g (/ g 255.0) 
          b (/ b 255.0) 
          n (min r g b) 
          m (max r g b) 
    ) 
    (if (zerop (setq d (- m n))) 
        (list 0 0 (fix (+ 0.5 (* m 100)))) 
        (progn 
            (if (< (setq l (/ (+ m n) 2.0)) 0.5) 
                (setq s (/ d (+ m n))) 
                (setq s (/ d (- 2.0 m n))) 
            ) 
            (cond 
                (   (= g m) (setq h (+ (/ (- b r) d) 2))) 
                (   (= b m) (setq h (+ (/ (- r g) d) 4))) 
                (   (setq h (/ (- g b) d))) 
            ) 
            (list 
                (fix (+ 0.5 (rem (+ 360 (* h 60)) 360))) 
                (fix (+ 0.5 (* s 100))) 
                (fix (+ 0.5 (* l 100))) 
            ) 
        ) 
    ) 
) 
 
;; HSL -> RGB  -  Lee Mac 
;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100 
 
(defun LM:HSL->RGB ( h s l / u v ) 
    (setq h (/ h 360.0) 
          s (/ s 100.0) 
          l (/ l 100.0) 
    ) 
    (cond 
        (   (zerop s) 
            (setq l (fix (+ 0.5 (* 255.0 l)))) 
            (list l l l) 
        ) 
        (   (zerop l) 
           '(0 0 0) 
        ) 
        (   (if (< l 0.5) 
                (setq v (* l (1+ s))) 
                (setq v (- (+ l s) (* l s))) 
            ) 
            (setq u (- (* 2.0 l) v)) 
            (mapcar 
                (function 
                    (lambda ( h ) 
                        (setq h (rem (1+ h) 1)) 
                        (cond 
                            (   (< (* 6.0 h) 1.0) 
                                (fix (+ 0.5 (* 255.0 (+ u (* 6.0 h (- v u)))))) 
                            ) 
                            (   (< (* 2.0 h) 1.0) 
                                (fix (+ 0.5 (* 255.0 v))) 
                            ) 
                            (   (< (* 3.0 h) 2.0) 
                                (fix (+ 0.5 (* 255.0 (+ u (* 6.0 (- (/ 2.0 3.0) h) (- v u)))))) 
                            ) 
                            (   (fix (+ 0.5 (* 255.0 u)))) 
                        ) 
                    ) 
                ) 
                (list (+ h (/ 1.0 3.0)) h (- h (/ 1.0 3.0))) 
            ) 
        ) 
    ) 
)

OLE & True

;; OLE -> True - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->True ( c )
(+ (lsh (lsh (lsh (fix c) 24) -24) 16)
(lsh (lsh (lsh (fix c) 16) -24) 08)
(lsh (lsh (fix c) 08) -24)
)
)
;; True -> OLE - Lee Mac
;; Args: c - [int] True Colour
(defun LM:True->OLE ( c )
(+ (lsh (lsh (fix c) 08) -24)
(lsh (lsh (lsh (fix c) 16) -24) 08)
(lsh (lsh (lsh (fix c) 24) -24) 16)
)
)

OLE & ACI

;; OLE -> ACI - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->ACI ( c )
(apply 'LM:RGB->ACI (LM:OLE->RGB c))
)
;; ACI -> OLE - Lee Mac
;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255)
(defun LM:ACI->OLE ( c )
(apply 'LM:RGB->OLE (LM:ACI->RGB c))
)

OLE & HSL

;; OLE -> HSL - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->HSL ( c )
(apply 'LM:RGB->HSL (LM:OLE->RGB c))
)
;; HSL -> OLE - Lee Mac
;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100
(defun LM:HSL->OLE ( h s l )
(apply 'LM:RGB->OLE (LM:HSL->RGB h s l))
)

True & ACI
;; True -> ACI - Lee Mac

;; Args: c - [int] True Colour

(defun LM:True->ACI ( c / o r )

(apply 'LM:RGB->ACI (LM:True->RGB c))

)

;; ACI -> True - Lee Mac

;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255)

(defun LM:ACI->True ( c / o r )

(apply 'LM:RGB->True (LM:ACI->RGB c))

)
;; True -> ACI - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->ACI ( c / o r ) (apply 'LM:RGB->ACI (LM:True->RGB c)) ) ;; ACI -> True - Lee Mac ;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255) (defun LM:ACI->True ( c / o r ) (apply 'LM:RGB->True (LM:ACI->RGB c)) )

True & HSL
;; True -> HSL - Lee Mac

;; Args: c - [int] True Colour

(defun LM:True->HSL ( c )

(apply 'LM:RGB->HSL (LM:True->RGB c))

)

;; HSL -> True - Lee Mac

;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100

(defun LM:HSL->True ( h s l )

(apply 'LM:RGB->True (LM:HSL->RGB h s l))

)
;; True -> HSL - Lee Mac ;; Args: c - [int] True Colour (defun LM:True->HSL ( c ) (apply 'LM:RGB->HSL (LM:True->RGB c)) ) ;; HSL -> True - Lee Mac ;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100 (defun LM:HSL->True ( h s l ) (apply 'LM:RGB->True (LM:HSL->RGB h s l)) )

ACI & HSL
;; ACI -> HSL - Lee Mac

;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255)

(defun LM:ACI->HSL ( c )

(apply 'LM:RGB->HSL (LM:ACI->RGB c))

)

;; HSL -> ACI - Lee Mac

;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100

(defun LM:HSL->ACI ( h s l )

(apply 'LM:RGB->ACI (LM:HSL->RGB h s l))

)
;; ACI -> HSL - Lee Mac ;; Args: c - [int] ACI (AutoCAD Colour Index) Colour (1<=c<=255) (defun LM:ACI->HSL ( c ) (apply 'LM:RGB->HSL (LM:ACI->RGB c)) ) ;; HSL -> ACI - Lee Mac ;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100 (defun LM:HSL->ACI ( h s l ) (apply 'LM:RGB->ACI (LM:HSL->RGB h s l)) )

ScmTools · 发表于 2013-6-7 21:35:57

Dear Sir,
I wonder if this color conversion function can be used in those areas, can explain in detail.

账号		自动登录	找回密码
密码			立即注册

[每日一码] Colour Conversion Functions

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子