Topic: True Color and Color Books using Vlisp

[Chris]

I've been working on this for quite a while and am about ready to pull my hair out.  I use a program to set our layerstates, and to create new layers if they dont exist.  basically I create a list of layers and their properties, then pass it to a program that uses the list to create the layers and add the properties.  How do I add a true color value or a color book value using this code?  Or do I need to tweak the code to pull it off?

Code: [Select]

   (defun c:createpresentationlayers (/ layerlist acm)
      (setq acm (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.18"))
      (setq layerlist
             '(
               ("Hatch Water" :vlax-false nil nil nil nil (vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 0 174 255));44799)
               ("Hatch Trees" :vlax-false nil nil nil nil (vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 127 255 0));8388352)
               ("Hatch Concrete" :vlax-false nil nil nil nil (vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 200 200 200));13158600)
               ("Hatch Grass" :vlax-false nil nil nil nil (vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 80 193 36));5292324)
               ("Hatch HMA" :vlax-false nil nil nil nil (vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 100 100 100));6579300)
               ("Hatch Gravel" :vlax-false nil nil nil nil (vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 174 100 0));11428864)
               ("Sign Yellow" :vlax-false nil nil nil nil (vla-SetColorBookColor acm "PANTONE(R) color bridge CMYK EC" "PANTONE 116 EC"))
               ("Sign Blue" :vlax-false nil nil nil nil (vla-SetColorBookColor acm "PANTONE(R) color bridge CMYK EC" "PANTONE 294 EC"))
               ("Sign Orange" :vlax-false nil nil nil nil (vla-SetColorBookColor acm "PANTONE(R) color bridge CMYK EC" "PANTONE 152 EC"))
               ("Sign Red" :vlax-false nil nil nil nil (vla-SetColorBookColor acm "PANTONE(R) color bridge CMYK EC" "PANTONE 187 EC"))
               ("Sign Green" :vlax-false nil nil nil nil (vla-SetColorBookColor acm "PANTONE(R) color bridge CMYK EC" "PANTONE 342 EC"))
               ("Sign Brown" :vlax-false nil nil nil nil (vla-SetColorBookColor acm "PANTONE(R) color bridge CMYK EC" "PANTONE 469 EC"))
               ("Sign Flourecent" :vlax-false nil nil nil nil (vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 175 255 0));'(175 255 0))
               ("Sign Purple" :vlax-false nil nil nil nil (vla-SetColorBookColor acm "PANTONE(R) color bridge CMYK EC" "PANTONE 259 EC"))
              )
      ) ;_ end of setq
      (alllayerset layerlist)
    ) ;_ end of defun

(defun alllayerset (lst / listlayer name match)
      (command "linetype" "_load" "*" "acad" "")
      (command "-layer" "SET" "0" "")
      (setq listlayer (vla-get-layers acaddocument))
      (foreach y lst
        (if (wcmatch (car y) "*`**")
          ()
          (if (tblsearch "LAYER" (car y))
            ()
            (vla-add listlayer (car y))
          ) ;_ end of if
        ) ;_ end of if
      ) ;_ end of foreach
      (vlax-for x listlayer
        (or (vl-position (setq name (strcase (vla-get-name x))) '("0" "DEFPOINTS"))
            (if (setq match (vl-remove-if-not
                              (function (lambda (x) (wcmatch name (strcase (car x)))))
                              lst
                            ) ;_ end of vl-remove-if-not
                ) ;_ end of setq
              (mapcar (function
                        (lambda (p v)
                          (if v
                            (vl-catch-all-apply
                              (function vlax-put-property)
                              (list x p v)
                            ) ;_ end of vl-catch-all-apply
                          ) ;_ end of if
                        ) ;_ end of lambda
                      ) ;_ end of function
                      '(Freeze Color LineType Plottable Description Truecolor)
                      (cdar match)
              ) ;_ end of mapcar
            ) ;_ end of if
        ) ;_ end of or
      ) ;_ end of vlax-for
      (setq name nil)
    ) ;_ end of defun


[Matt__W]

You might find some help here.  There's a lot of LSPs regarding colors (RGB, True Colors and color conversions)

http://www.jtbworld.com/lisp/DisplayColorProperties.htm

[Fred Tomke]

Hi, Chris, does this really work?

Code: [Select]

(vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 0 174 255)
It's new to me that vla-put-ColorMethod returns the given AcCmColor-object.
I'd be careful hardcoding the AcCmColor object version ("AutoCAD.AcCmColor.18").

I think you could not avoid to define an additional function which interprets your desired color and returns it in a truecolor object
Then you can use

• (truecolor 7)
• ("Hatch Water" :vlax-false nil nil nil nil (truecolor (list 0 174 255)))
• ("Sign Red" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 187 EC")))

Code: [Select]

(defun truecolor (uColor / oColor)
  (setq oColor (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.18"))
  (cond
    ((= (type uColor) 'INT)
     (vla-put-ColorMethod oColor acColorMethodByACI)
     (vla-put-ColorIndex oColor uColor))
    ((not (listp uColor)) nil)
    ((= (length uColor) 3)
     (vla-put-ColorMethod oColor acColorMethodByRGB)
     (vla-SetRGB oColor (car uColor) (cadr uColor) (last uColor))
    ((= (length uColor) 2)
     (vla-SetColorBookColor oColor (car uColor) (cadr uColor)))
  ); cond
  oTruecolor
); truecolor
Hope this helps,
Fred

[Chris]

Hi, Chris, does this really work?

Code: [Select]

(vla-SetRGB (vla-put-ColorMethod acm acColorMethodByRGB) 0 174 255)

no, it doesnt work, thats what I need help on.  Based on several of the sites I've visited, this is what it appears they say to do, however, when I do it, it returns Nil, so nothing gets passed on in the rest of the program.

Fred, I also tried your variation, and I'm still getting nil passed on to the program.

[MP]

I've not run any of the code but I would caution assuming it didn't work because it returned nil, some methods are like that. I would inspect the target object to verify.

[Chris]

The colors of the layers aren't changing, and my understanding of the program is that what gets passed to the truecolor property should be the results of the truecolor program, but the output (oTruecolor) returns nil when inspected.  Is this not the way the program should function?

[dgorsman]

Changing the settings of the interface object does nothing but change the interface object, even if it was derived from a layer.  Under any of the provided examples I'm not seeing the essential step - assigning the interface object *back* to the layer e.g. (vla-put-TrueColor layer_obj color_obj).

[ronjonp]

As dgorsman said ... this works fine for me:

Code: [Select]

(defun getcolorobject ()
  (vla-getinterfaceobject
    (vlax-get-acad-object)
    (strcat "AutoCAD.AcCmColor." (substr (getvar "acadver") 1 2))
  )
)
(setq olay (vlax-ename->vla-object (tblobjname "layer" "0")))

(setq oclr (getcolorobject))

(vla-setrgb oclr 0 174 175)

(vla-put-truecolor olay oclr)
and it does return nil:

GETCOLOROBJECT
#<VLA-OBJECT IAcadLayer 0e92e84c>
#<VLA-OBJECT IAcadAcCmColor 100ad040>
nil
nil

[Chris]

yes, but how do I get it to work with the main programming?  Or do I have to run this separately?
I'm guessing that it will not work with
vlax-put-property 'truecolor

[Fred Tomke]

Fred, I also tried your variation, and I'm still getting nil passed on to the program.

That's right, because there was my favorite bug - I like bugs caused by uncontrolled copy & paste. Grrmpf. This should work now:

Code: [Select]

(defun truecolor (uColor / oColor)
  (setq oColor (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.18"))
  (cond
    ((= (type uColor) 'INT)
     (vla-put-ColorMethod oColor acColorMethodByACI)
     (vla-put-ColorIndex oColor uColor))
    ((not (listp uColor)) nil)
    ((= (length uColor) 3)
     (vla-put-ColorMethod oColor acColorMethodByRGB)
     (vla-SetRGB oColor (car uColor) (cadr uColor) (last uColor))
    ((= (length uColor) 2)
     (vla-SetColorBookColor oColor (car uColor) (cadr uColor)))
  ); cond
  oColor
); truecolor


Fred

[ronjonp]

yes, but how do I get it to work with the main programming?  Or do I have to run this separately?
I'm guessing that it will not work with
vlax-put-property 'truecolor

This works too:

(vlax-put olay 'truecolor oclr)

All the code is there just change the colorobject before applying to the layer and it should work. Although I could be completely off .... it seems to happen more and more lately 

[T.Willey]

Should one release the Color object that is gotten in your code Ron?

[ronjonp]

Should one release the Color object that is gotten in your code Ron?

Ummmm ... not sure  I'd imagine it would not hurt but I'd have to leave that answer to the forum gurus .

[dgorsman]

I can't remember where I saw it, but something is wedged in my brain saying that the AcCmColor object is a static object, with the implication that there is only one of them in any given AutoCAD, implemented via the interface object.  I don't explicitly release the interface object and haven't run into problems with it.

[Chris]

ok, I know what it is doing, it isnt processing the function as the last item in the list.
it is just transfering (truecolor (list 0 174 255)) as the last item in the list.  Got it figured now, I cant use ' I have to use LIST.
Thanks for everyones help
Here is the finished code for anyone else to use:

Code: [Select]

(defun c:createpresentationlayers (/ layerlist acm)
      (setq layerlist
             (list
               (list "Hatch Water" :vlax-false nil nil nil nil (truecolor (list 0 174 255)));44799)
               (list "Hatch Trees" :vlax-false nil nil nil nil (truecolor (list 127 255 0)));8388352)
               (list "Hatch Concrete" :vlax-false nil nil nil nil (truecolor (list 200 200 200)));13158600)
               (list "Hatch Grass" :vlax-false nil nil nil nil (truecolor (list 80 193 36)));5292324)
               (list "Hatch HMA" :vlax-false nil nil nil nil (truecolor (list 100 100 100)));6579300)
               (list "Hatch Gravel" :vlax-false nil nil nil nil (truecolor (list 174 100 0)));11428864)
               (list "Sign Yellow" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 116 EC")))
               (list "Sign Blue" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 294 EC")))
               (list "Sign Orange" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 152 EC")))
               (list "Sign Red" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 187 EC")))
               (list "Sign Green" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 342 EC")))
               (list "Sign Brown" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 469 EC")))
               (list "Sign Flourecent" :vlax-false nil nil nil nil (truecolor (list 175 255 0)));'(175 255 0))
               (list "Sign Purple" :vlax-false nil nil nil nil (truecolor (list "PANTONE(R) color bridge CMYK EC" "PANTONE 259 EC")))
              )
      ) ;_ end of setq
      (alllayerset layerlist)
    ) ;_ end of defun
;;****************************************************************************************************************************************
(defun truecolor (uColor / oColor)
      (setq oColor (vla-getinterfaceobject (vlax-get-acad-object) "AutoCAD.AcCmColor.18"))
      (cond
        ((= (type uColor) 'INT)
         (vla-put-ColorMethod oColor acColorMethodByACI)
         (vla-put-ColorIndex oColor uColor))
        ((not (listp uColor)) nil)
        ((= (length uColor) 3)
         (vla-put-ColorMethod oColor acColorMethodByRGB)
         (vla-SetRGB oColor (car uColor) (cadr uColor) (last uColor)))
        ((= (length uColor) 2)
         (vla-SetColorBookColor oColor (car uColor) (cadr uColor)))
        ); cond
      ocolor
      ); truecolor
 ;;****************************************************************************************************************************************
    (defun alllayerset (lst / listlayer name match)
      (command "linetype" "_load" "*" "acad" "")
      (command "-layer" "SET" "0" "")
      (setq listlayer (vla-get-layers acaddocument))
      (foreach y lst
        (if (wcmatch (car y) "*`**")
          ()
          (if (tblsearch "LAYER" (car y))
            ()
            (vla-add listlayer (car y))
          ) ;_ end of if
        ) ;_ end of if
      ) ;_ end of foreach
      (vlax-for x listlayer
        (or (vl-position (setq name (strcase (vla-get-name x))) '("0" "DEFPOINTS"))
            (if (setq match (vl-remove-if-not
                              (function (lambda (x) (wcmatch name (strcase (car x)))))
                              lst
                            ) ;_ end of vl-remove-if-not
                ) ;_ end of setq
              (mapcar (function
                        (lambda (p v)
                          (if v
                            (vl-catch-all-apply
                              (function vlax-put-property)
                              (list x p v)
                            ) ;_ end of vl-catch-all-apply
                          ) ;_ end of if
                        ) ;_ end of lambda
                      ) ;_ end of function
                      '(Freeze Color LineType Plottable Description Truecolor)
                      (cdar match)
              ) ;_ end of mapcar
            ) ;_ end of if
        ) ;_ end of or
      ) ;_ end of vlax-for
      (setq name nil)
    ) ;_ end of defun