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

Select all
;; RGB -> OLE  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->OLE ( r g b )
    (logior (fix r) (lsh (fix g) 8) (lsh (fix b) 16))
)

;; OLE -> RGB  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)

RGB & True

Select all
;; RGB -> True  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->True ( r g b )
    (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b))
)

;; True -> RGB  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->RGB ( c )
    (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24))
)

RGB & ACI

Select all
;; RGB -> ACI  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->ACI ( r g b / c o )
    (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
        (progn
            (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
            (vlax-release-object o)
            (if (vl-catch-all-error-p c)
                (prompt (strcat "\nError: " (vl-catch-all-error-message c)))
                c
            )
        )
    )
)

;; 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
            (setq r
                (vl-catch-all-apply
                   '(lambda ( )
                        (vla-put-colorindex o c)
                        (list (vla-get-red o) (vla-get-green o) (vla-get-blue o))
                    )
                )
            )
            (vlax-release-object o)
            (if (vl-catch-all-error-p r)
                (prompt (strcat "\nError: " (vl-catch-all-error-message r)))
                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

Select all
;; 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)
    )
    (mapcar '(lambda ( x ) (fix (+ 0.5 (* 255 x))))
        (cond
            (   (zerop s) (list l l l))
            (   (zerop l)'(0 0 0))
            (   (setq v (if (< l 0.5) (* l (1+ s)) (- (+ l s) (* l s)))
                      u (-  (* 2.0 l) v)
                )
                (mapcar
                   '(lambda ( h )
                        (setq h (rem (1+ h) 1))
                        (cond
                            (   (< (* 6.0 h) 1.0) (+ u (* 6.0 h (- v u))))
                            (   (< (* 2.0 h) 1.0) v)
                            (   (< (* 3.0 h) 2.0) (+ u (* 6.0 (- (/ 2.0 3.0) h) (- v u))))
                            (   u   )
                        )
                    )
                    (list (+ h (/ 1.0 3.0)) h (- h (/ 1.0 3.0)))
                )
            )
        )
    )
)

OLE & True

Select all
;; OLE -> True  -  Lee Mac
;; Args: c - [int] OLE Colour

(defun LM:OLE->True ( c )
    (apply 'logior
        (mapcar
           '(lambda ( x ) (lsh (lsh (lsh (fix c) x) -24) (- x 8)))
           '(24 16 08)
        )
    )
)

;; True -> OLE  -  Lee Mac
;; Args: c - [int] True Colour

(defun LM:True->OLE ( c )
    (apply 'logior
        (mapcar
           '(lambda ( x ) (lsh (lsh (lsh (fix c) x) -24) (- x 8)))
           '(08 16 24)
        )
    )
)

OLE & ACI

Select all
;; 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

Select all
;; 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

Select all
;; 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

Select all
;; 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

Select all
;; 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))
)

textsize

increase · reset · decrease

Designed & Created by Lee Mac © 2010