LISP to get layer color and linetype and apply to all objects

[Anonymous]

Hello folks,

I've tried to find here some LISP, but I can't find anything similar to this: I was looking for some LISP that runs without asking to make any selection (just by loading it), and that applies to ALL objects in Model Space doing the following actions/steps:

-Gets the Color and Linetype of the layer where the objects/entities are inserted and applies to the objects properties;

-After that changes ALL objects/entities Lineweights to ByLayer;

-And then change Linetype Scales of ALL objects/entities to 1.0.

Please, could anyone help me with those "simple" tasks?

Thanks.

[doaiena · Accepted solution]

I think this should do the job. Test it and tell me if it works for you.

(defun c:test ( / ss acadDoc layers ctr obj )

(if (setq ss (ssget "X" '((410 . "Model"))))
(progn

(setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq layers (vla-get-Layers acadDoc))

(setq ctr 0)
(repeat (sslength ss)

(setq obj (vlax-ename->vla-object (ssname ss ctr)))

(if (and (vlax-property-available-p obj 'Color T)
	 (vlax-property-available-p obj 'LineType T)
	 (vlax-property-available-p obj 'LineWeight T)
	 (vlax-property-available-p obj 'LineTypeScale T)
    )
(progn

(vlax-put-property obj 'Color (vla-get-Color (vla-item layers (vlax-get-property obj 'Layer))))
(vlax-put-property obj 'Linetype (vla-get-Linetype (vla-item layers (vlax-get-property obj 'Layer))))
(vlax-put-property obj 'LineWeight acLnWtByLayer)
(vlax-put-property obj 'LineTypeScale 1.0)
));if prop available

(setq ctr (1+ ctr))
);repeat

));if ss

);defun

[Kent1Cooper]

Here's what I use -- ByLayer.lsp [attached].  It may change more properties than you want -- remove those you don't care about.  And despite the name, its commands put some properties to other than "ByLayer" when the default is something else [e.g. thickness to 0].

It has four commands:  BYce sets not objects but all the Current-Entity settings to defaults.  BYs sets all properties of Selected objects to defaults.  BYall sets all properties of All objects in the current space  to defaults.  BYevery sets all properties of Everything in the entire drawing  to defaults.

[Anonymous]

---

@Kent1Cooper wrote:

Here's what I use -- ByLayer.lsp [attached].  It may change more properties than you want -- remove those you don't care about.  And despite the name, its commands put some properties to other than "ByLayer" when the default is something else [e.g. thickness to 0].

It has four commands:  BYce sets not objects but all the Current-Entity settings to defaults.  BYs sets all properties of Selected objects to defaults.  BYall sets all properties of All objects in the current space  to defaults.  BYevery sets all properties of Everything in the entire drawing  to defaults.

---

Uhmm, this is not I'm looking for. I wish the layer color and linetype was embeded as objects properties. Thanks anyway!

[Anonymous]

---

@doaiena wrote:

I think this should do the job. Test it and tell me if it works for you.

(defun c:test ( / ss acadDoc layers ctr obj )

(if (setq ss (ssget "X" '((410 . "Model"))))
(progn

(setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq layers (vla-get-Layers acadDoc))

(setq ctr 0)
(repeat (sslength ss)

(setq obj (vlax-ename->vla-object (ssname ss ctr)))

(if (and (vlax-property-available-p obj 'Color T)
	 (vlax-property-available-p obj 'LineType T)
	 (vlax-property-available-p obj 'LineWeight T)
	 (vlax-property-available-p obj 'LineTypeScale T)
    )
(progn

(vlax-put-property obj 'Color (vla-get-Color (vla-item layers (vlax-get-property obj 'Layer))))
(vlax-put-property obj 'Linetype (vla-get-Linetype (vla-item layers (vlax-get-property obj 'Layer))))
(vlax-put-property obj 'LineWeight acLnWtByLayer)
(vlax-put-property obj 'LineTypeScale 1.0)
));if prop available

(setq ctr (1+ ctr))
);repeat

));if ss

);defun

---

Thanks man! That's worked perfectly! I've forgot to mention those cases when the objects already have some specific color or linetype assigned to them. Could you add a step in your routine to keep intact only those objects that already have color and linetype assigned to them as it is? In other hand, every object that has Color, Linetype setted to ByLayer should take the Color and the Linetype from the layer.

Imagine that my intention is to keep everything intact, just how it looks like on the screen by incorporating the properties to every element, like color and linetypes, for example. It will come from layers, in cases in which the property of the object is setted "ByLayer" or already inside each element (in case the objects have already color and linetype inside their properties), so then I can move all those objects to a same layer keeping visual integrity. 

Hope I made myself clear enough. Thanks a lot great sir! 🙂

[3wood]

You can try CHZ20.

Firstly, run it in a drawing and settings as below:

Then add CHZ20.vlx to you Startup Suite so it can be loaded automatically whenever a drawing is opened.

Then add one code line into your S::startup function in your acaddoc.lsp so it will run automatically whenever a drawing is opening:

S::startup function is similar like this:

(defun S::startup ()
  (Chz20_cmd T)
)

[doaiena · Accepted solution]

There you go. It should now work as intended.

(defun c:test ( / ss acadDoc layers ctr obj )

(if (setq ss (ssget "X" '((410 . "Model"))))
(progn

(setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq layers (vla-get-Layers acadDoc))

(setq ctr 0)
(repeat (sslength ss)

(setq obj (vlax-ename->vla-object (ssname ss ctr)))

(if (and (vlax-property-available-p obj 'Color T)
	 (vlax-property-available-p obj 'LineType T)
	 (vlax-property-available-p obj 'LineWeight T)
	 (vlax-property-available-p obj 'LineTypeScale T)
    )
(progn

(if (equal (vla-get-Color obj) 256) (vlax-put-property obj 'Color (vla-get-Color (vla-item layers (vlax-get-property obj 'Layer)))))
(if (equal (vla-get-Linetype obj) "ByLayer") (vlax-put-property obj 'Linetype (vla-get-Linetype (vla-item layers (vlax-get-property obj 'Layer)))))
(vlax-put-property obj 'LineWeight acLnWtByLayer)
(vlax-put-property obj 'LineTypeScale 1.0)
));if prop available

(setq ctr (1+ ctr))
);repeat

));if ss
(princ)
);defun

[Anonymous]

It worked perfectly man. Please, I was doing some pratical tests here and I've just noticed that by replacing the Lintype Scales by 1.0 was changing how some geometries are showing on screen. To change that, should I just delete these two lines:

Thanks a lot for your help! 🙂

[doaiena · Accepted solution]

Yes. You can just delete those lines, or comment them out using semicolon ";". The first line checks whether an object has a property called "LineTypeScale" and the second line changes that property to 1.0.

[Anonymous]

Hi,

I liked your LISP routine very much, I was wondering if a variation would be possible that allows me to first select the entity whose properties I want to edit (mostly a line or polyline) and then asks me to set its property regarding linecolour, lineweight and linetype and THEN applies these settings to each and every line or polyline in the whole drawing, that is in every tab or layout where that specific line occurs...

Is that possible?

Thanks in advance! 

[Anonymous]

Awesome;

Could you please make this code work with 'Selected objects only' and 'include nested blocks'.

Thank you

[latif_ozdem]

That lisp can help a lot to me. Thank you for sharing. Is there any similar lisp which works with nested ones (e.g. in Blocks) too? 

[Kent1Cooper]

---

@latif_ozdem wrote:

.... Is there any similar lisp which works with nested ones (e.g. in Blocks) too? 

---

There's the SETBYLAYER command, which may not have existed yet when my routine was originally written.