CHANGE COLOR BYLAYER

[Sandervp]

Hello everybody,

I'm using this lisp file from all-in-one-layer. I've changed this a little bit and it works well. But it doesn't works perfect.

This is my lisp;

(vl-load-com)
(defun c:DTG (/ adoc lay layers laylst locklst x)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq layers (vla-Get-Layers adoc))
  (vlax-for lay layers
    (if (= (vla-get-lock lay) :vlax-true)
      (progn
        (setq locklst (cons (vla-get-name lay) locklst))
        (vla-put-lock lay :vlax-false)
      )
    )
  )
  (setq laylst '(("DIMENSIONS" 1) ("Leader" 2) ("Text" 2) ("GUIDELINE" 6)))
  (mapcar '(lambda (x)
             (setq lay (vla-add layers (car x)))
             (vla-put-color lay (cadr x))
           )
          laylst
  )
  (vlax-for layt (vla-get-layouts adoc)
    (vlax-for blk (vla-get-block layt)
      (cond ((wcmatch (vla-get-objectname blk) "*Dimension*")
             (vla-put-layer blk "DIMENSIONS")
            )
            ((wcmatch (vla-get-objectname blk) "*Leader")
             (vla-put-layer blk "TEXT")
            )
            ((wcmatch (vla-get-objectname blk) "*Text")
             (vla-put-layer blk "TEXT")
            )
            ((wcmatch (vla-get-objectname blk) "*Xline")
             (vla-put-layer blk "GUIDELINE")
            )
      )
    )
  )
  (if locklst
    (vlax-for lay layers
      (if (vl-position (vla-get-name lay) locklst)
        (vla-put-lock lay :vlax-true)
      )
    )
  )
(COMMAND "-LAYER" "PLOT" "N" "GUIDELINE" "")
   (princ)
)

The differnce between the original and my lisp file, my lisp does create a new (no plot) layer and also it puts the leaders into the layer text.

After using it, every dimension/ leader/ text objects and guidelines became the right layer. But not every dimension/ leader/ text objects and guidelines do have the right color.

This because the object properties are changed into another color instead of color bylayer.

What do I have to change or add to make it works well?

Thanks

[regisrohde · Accepted solution]

Hi
Add line:
(vla-put-Color BLK 256)

(vlax-for layt (vla-get-layouts adoc)
    (vlax-for blk (vla-get-block layt)
      (cond ((wcmatch (vla-get-objectname blk) "*Dimension*")
             (vla-put-layer blk "DIMENSIONS")
			 (vla-put-Color BLK 256)
            )
            ((wcmatch (vla-get-objectname blk) "*Leader")
             (vla-put-layer blk "TEXT")
			 (vla-put-Color BLK 256)
            )
            ((wcmatch (vla-get-objectname blk) "*Text")
             (vla-put-layer blk "TEXT")
			 (vla-put-Color BLK 256)
            )
            ((wcmatch (vla-get-objectname blk) "*Xline")
             (vla-put-layer blk "GUIDELINE")
			 (vla-put-Color BLK 256)
            )
      )
    )
  )

[Sandervp]

Thanks for your sollution! It's works perfect!

Thank you Regisrohde

[Kent1Cooper · Accepted solution]

---

@Anonymous wrote:

Hi
Add line:
(vla-put-Color BLK 256)

---

I would think, since you're applying color 256 in all conditions, you could do it once for all objects, rather than separately within each condition:

(vlax-for layt (vla-get-layouts adoc)
    (vlax-for blk (vla-get-block layt)
      (cond ((wcmatch (vla-get-objectname blk) "*Dimension*")
             (vla-put-layer blk "DIMENSIONS")
            )
            ((wcmatch (vla-get-objectname blk) "*Leader,*Text"); you can combine these
             (vla-put-layer blk "TEXT")
            )
            ((wcmatch (vla-get-objectname blk) "*Xline")
             (vla-put-layer blk "GUIDELINE")
            )
      )
      (vla-put-Color blk 256) 
    )
  )

Or, if perhaps you don't want things other than those few object types changed to Bylayer color, it can still be one code line, though a longer one:

      (if (wcmatch (vla-get-objectname blk) "*Dimension*,*Leader,*Text,*Xline") (vla-put-Color blk 256))

Other code-reduction possibilities:  do the entity-type determination only once, and to do the Layer assignment function only once, with the determination of which Layer to assign inside it.  This also restricts the color assignment to only those entity types by doing it not with its own check, but inside the result of an overall entity-type check which applies to both Layer and color processing:

(vlax-for layt (vla-get-layouts adoc)
  (vlax-for blk (vla-get-block layt)
    (if (wcmatch (setq etype (vla-get-objectname blk)) "*Dimension*,*Leader,*Text,*Xline"); only these types
      (progn ; then
        (vla-put-layer blk
          (cond
            ((wcmatch etype "*Dimension*") "DIMENSIONS")
            ((wcmatch etype "*Leader,*Text") "TEXT")
            ("GUIDELINE"); Xline only remaining possibility -- no need to test for it
          ); cond
        );vla-put-layer
        (vla-put-Color blk 256)
      ); progn
    ); if
  ); vlax-for
); vlax-for

[Sandervp]

Also, thank you Kent Cooper!

I'm using your last possibility now;

(vlax-for layt (vla-get-layouts adoc)
  (vlax-for blk (vla-get-block layt)
    (if (wcmatch (setq etype (vla-get-objectname blk)) "*Dimension*,*Leader,*Text,*Xline"); only these types
      (progn ; then
        (vla-put-layer blk
          (cond
            ((wcmatch etype "*Dimension*") "DIMENSIONS")
            ((wcmatch etype "*Leader,*Text") "TEXT")
            ("GUIDELINE"); Xline only remaining possibility -- no need to test for it
          ); cond
        );vla-put-layer
        (vla-put-Color blk 256)
      ); progn
    ); if
  ); vlax-for
); vlax-for

Also thanks you for the explanation behind some sentences. It's easier to understand.

[Sandervp]

Hello Kent,

Is it also possible to change every object into the layer dimension, text or guideline with this command, except if the object is from a specific layer?

Thank you

[Kent1Cooper · Accepted solution]

---

@Sandervp wrote:

.... 

Is it also possible to change every object into the layer dimension, text or guideline with this command, except if the object is from a specific layer?

....

---

....

    (if

      (and

        (wcmatch (setq etype (vla-get-objectname blk)) "*Dimension*,*Leader,*Text,*Xline"); only these types

        (/= (vla-get-Layer blk) "YourSpecificLayerName")

      ); and
      (progn ; then

....

[Sandervp]

Thank again Kent!

I've added those red lines into my lisp and changed the "yourspecificlayername" into the right layer. The only thing I had to do was copy this line a couple times for only 1 layer.

Because if I have text from the layer; "example" and my specific layer is "example", nothing goes wrong. But if I have the layer; "EXAMPLE" or "Example" and the specific layer is still "example" it goes wrong.

It's a little bit strange because you can't create the layers "example", "EXAMPLE" and "Example" in one drawing. You will get a message the layer already excist. Why does he change the layer into the layer text despite the layer is good but the way how the layer is written.

Thank you Kent!

[Kent1Cooper]

---

@Sandervp wrote:

... if I have text from the layer; "example" and my specific layer is "example", nothing goes wrong. But if I have the layer; "EXAMPLE" or "Example" and the specific layer is still "example" it goes wrong. .....

---

You can get around that with one test by forcing the object's Layer name to all upper-case, regardless of its case conditions in the actual Layer name, and giving it the specific Layer name likewise, and comparing those:

  (/= (strcase (vla-get-Layer blk)) "YOURSPECIFICLAYERNAME")