vla-SetRGB or vla-put-TrueColor . . .

Hi Domenico

Tja, TrueColor is a little bit tricky:
;
; == Function VxGetTruCol
; Returns a TrueColor list from an object.
; Arguments [Type]:
; Obj = Object to read [VLA-OBJECT]
; Return [Type]:
; > RGB list INT's '(R G B)

• 
  ; Notes:
  ; None
  ;
  (defun VxGetTruCol (Obj)
  (mapcar
  '(lambda (l)
  (vlax-get (vla-get-TrueColor Obj) l)
  ) '(Red Green Blue)
  )
  )
  ;
  ; == Function VxGetTruCol
  ; Applies a TrueColor list to an object.
  ; Arguments [Type]:
  ; Obj = Object to modify [VLA-OBJECT]
  ; Lst = RGB list of INT's '(R G B)
  • 
    ; Return [Type]:
    ; > Modified object [VLA-OBJECT]
    ; Notes:
    ; None
    ;
    (defun VxSetTrueCol (Obj Lst / ColObj)
    (setq ColObj (vla-GetInterfaceObject
    (vlax-get-acad-object)
    "AutoCAD.AcCmColor.16"
    )
    )
    (vla-SetRGB ColObj (car Lst) (cadr Lst) (caddr Lst))
    (vla-put-TrueColor Obj ColObj)
    (vlax-release-object ColObj)
    Obj
    )
    
    Cheers

 

Hi.
I'm attemting to write a code that is able
to get the color of a layer
and to restore it later.

To get layer color I do this :
(setq layer-TrueColor (vla-get-TrueColor layer-object ))
(setq layer-RGB-list
(list (vla-get-red layer-TrueColor)
(vla-get-Green layer-TrueColor)
(vla-get-Blue layer-TrueColor)
)
)

While I'm finding difficulties attempting to restore these color values.

(vla-put-TrueColor layer-object
(vlax-make-variant (vlax-SafeArray-Fill (vlax-Make-SafeArray vlax-vbInteger (cons 0 2)) layer-RGB-list ))
; red green blue
; layer-RGB-list
; (vlax-SafeArray-Fill (vlax-Make-SafeArray vlax-vbInteger (cons 0 2)) layer-RGB-list )
)

I always get some kind of error.

Please help me.

Ciao
Domenico

 

Thank you very much.
I will try it.
However it seems to be very complicated to understand for me, without your
help.
Thanks again.
Ciao
Domenico

 

Domenico

You are welcome...¦-)

- Open the Visual LISP help in VLIDE -> Search -> TrueColor
- Read the TrueColor example (VBA) and translate it to Visual LISP
- To learn about VBA -> Visual LISP translation, see the
Visual LISP help -> AutoLISP Developer's Guide -> Working with ActiveX ->
Using Visual LISP Functions with ActiveX Methods

Cheers

 

;-) Sorry Jürg.

I replied to your private e-mail address.

.. . . . . . .


Using your suggestion I have written this working code.
Is it all right ?
Domenico

;----------------------------------------------------------------------------------------------------------------------
(defun :VLA_GET_COLOR (object / COLOR-METHOD COLOR-OBJECT R)
(setq color-object (vla-get-TrueColor object )
color-method (vla-get-ColorMethod color-object )
)
(cond
( (= color-method acColorMethodByACI)
(setq r (list acColorMethodByACI (vla-get-ColorIndex color-object)))
)
( (= color-method acColorMethodByRGB)
(setq r (list acColorMethodByRGB (vla-get-red color-object)
(vla-get-Green color-object) (vla-get-Blue color-object) ) )
)
)
r
)



;----------------------------------------------------------------------------------------------------------------------
(defun :VLA_SET_COLOR (object color-list / COLOR-METHOD COLOR-OBJECT)
(setq color-object (vla-GetInterfaceObject ACAD_OBJECT)
"AutoCAD.AcCmColor.16"))
(setq color-method (nth 0 color-list))
(cond
( (= color-method acColorMethodByACI)
(vla-put-ColorMethod color-object acColorMethodByACI)
(vla-put-ColorIndex color-object (nth 1 color-list))
(vla-put-TrueColor object color-object)
(vlax-release-object color-object)
object
)
( (= color-method acColorMethodByRGB)
(vla-put-ColorMethod color-object acColorMethodByRGB)
(vla-SetRGB color-object (nth 1 color-list) (nth 2 color-list) (nth 3
color-list))
(vla-put-TrueColor object color-object)
(vlax-release-object color-object)
object
)
)
)

 

Hi Domenico

As I replied directly to you, but also for other interested ng readers:

In order to arrange the code more flexible, I propose the following
changes:
- Works with all objects (not only Layers)
- Get/Set ByLayer, ByBlock and Foreground also
; -----------------------------------------------------------------------------
; Comments:
; - Variable 'r' is not necessary, 'cond' or 'if' returns the last evaluated
; value.
; - There are only two possible conditions (acColorMethodByRGB and the rest),
; therefore use 'if' instead of 'cond'.
; - vla-get-Red etc. can be replaced by 'vlax-get' inside a mapcar function
; - The actual ColorMethod is stored in color-method, therefore you can set
; the return value by the variable.
(defun :VLA_GET_COLOR (object / COLOR-METHOD COLOR-OBJECT)
(setq color-object (vla-get-TrueColor object)
color-method (vla-get-ColorMethod color-object)
)
(if (= color-method acColorMethodByRGB)
(cons
color-method
(mapcar
'(lambda (l) (vlax-get color-object l)) '(Red Green Blue)
)
)
(cons color-method (vla-get-ColorIndex color-object))
)
)
; -----------------------------------------------------------------------------
; Comments:
; - vla-put-ColorMethod, vla-put-TrueColor and vlax-release-object are common
; for all color methods.
; - There are only two possible conditions (acColorMethodByRGB and the rest),
; therefore use 'if' instead of 'cond'.
; - The changed list format in :VLA_GET_COLOR requires another access to the
; list (nth -> car, cdr etc.).
(defun :VLA_SET_COLOR (object color-list / COLOR-METHOD COLOR-OBJECT)
(setq color-object (vla-GetInterfaceObject
ACAD_OBJECT)
"AutoCAD.AcCmColor.16"
)
color-method (car color-list)
)
(vla-put-ColorMethod color-object color-method)
(if (= color-method acColorMethodByRGB)
(vla-SetRGB
color-object
(cadr color-list) (caddr color-list) (cadddr color-list)
)
(vla-put-ColorIndex color-object (cdr color-list))
)
(vla-put-TrueColor object color-object)
(vlax-release-object color-object)
object
)
; -----------------------------------------------------------------------------

 

Thank You.
Meticulous and usefulf suggestions.
Domenico

; --------------------------------------------------------------------------
---

; --------------------------------------------------------------------------
---

; --------------------------------------------------------------------------
---