LISP routine to select lineweight and scale

October 4, 2016

Hi,

I am new to the forum and I would like some help with a LISP routine.

I need the routine to do the following:

1. Select all items in the drawing and scale them up by 5.

2. Select all items with a lineweight '0.50mm' and change the colour to 'By Layer' and also put them onto the '0existing' layer.

3. Select all items on the 'Layer 1' layer and put them onto the '0' layer.

Hopefully someone can help with this, it doesn't sound like much but it will save me lots of time!

Thanks

October 4, 2016

Something to start with:

(defun C:test ( / SSX i e enx )
(vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
(if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
	(progn
		(command "_.SCALE" SSX "" '(0. 0. 0.) 5)
		(repeat (setq i (sslength SSX))
			(setq e (ssname SSX (setq i (1- i))))
			(setq enx (entget e))
			(if (= "Layer1" (cdr (assoc 8 enx)))
				(entupd (cdr (assoc -1 (entmod (setq enx (subst (cons 8 "0") (assoc 8 enx) enx))))))
			)
			(if (and (assoc 370 enx) (= 50 (cdr (assoc 370 enx))))
				(progn
					(setq enx (vl-remove-if '(lambda (x) (member (car x) '(62 420))) enx))
					(setq enx (subst (cons 8 "0") (assoc 8 enx) enx))
					(entupd (cdr (assoc -1 (entmod enx))))
				)
			)		
		)
		(vla-ZoomExtents (vlax-get-acad-object))
	)
)
(princ)
);| defun |; (vl-load-com) (princ)

October 5, 2016

Welcome to CADTutor andy_06.

Your profile says that you are using LT?

If you are using LT, lisp won't work.

October 5, 2016

Many thanks for that, it is almost what I am looking for which is great!

At the moment it scales my map to the correct size and puts the 0.50mm lineweights onto the correct layer.

The only parts that don't seem to work is the 0.50mm lineweights stay as colour red but I need them to change to 'By Layer' if that is possible?

And also stage 3 where I need everything on 'Layer 1' to move onto '0' layer at the end.

There may be a couple more things I think of as I am using it but this is a very good start so thanks a lot.

October 5, 2016

Welcome to CADTutor andy_06.

Your profile says that you are using LT?

If you are using LT, lisp won't work.

Hi Dadgad,

Apologies for that, I have updated my profile!

October 5, 2016

Many thanks for that, it is almost what I am looking for which is great!

At the moment it scales my map to the correct size and puts the 0.50mm lineweights onto the correct layer.

The only parts that don't seem to work is the 0.50mm lineweights stay as colour red but I need them to change to 'By Layer' if that is possible?

And also stage 3 where I need everything on 'Layer 1' to move onto '0' layer at the end.

There may be a couple more things I think of as I am using it but this is a very good start so thanks a lot.

It seems that I did a typo, on 'Layer 1' - I wrote 'Layer1' instead,

Also it seems that entity won't change its color ByLayer by removing GC 62 from its elist.. so lets try subst GC 62 to (62 . 256):

(defun C:test ( / lyr1 lyr0 acDoc emakeLay SSX i e enx )

(setq lyr1 "Layer 1");<- type your layername here
(setq lyr0 "0existing");<- type your layername for lineweight 0.50mm

(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
(defun emakeLay (nm)
	(or (tblsearch "LAYER" nm)
		(progn
			(alert (strcat "\nLayer \"" nm "\" does not exist, creating it!"))
			(entmakex (list (cons 0 "LAYER")(cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 nm)(cons 70 0)))
		)
	)
	(princ)
); defun emakeLay
(mapcar 'emakeLay (list lyr0 lyr1))

(if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
	(progn
		(command "_.SCALE" SSX "" '(0. 0. 0.) 5)
		(repeat (setq i (sslength SSX))
			(setq e (ssname SSX (setq i (1- i))))
			(setq enx (entget e))
			(if (= lyr1 (cdr (assoc 8 enx)))
				(entupd (cdr (assoc -1 (entmod (setq enx (subst (cons 8 "0") (assoc 8 enx) enx))))))
			)
			(if (and (assoc 370 enx) (= 50 (cdr (assoc 370 enx))))
				(progn
					(setq enx (vl-remove-if '(lambda (x) (= (car x) 420)) enx))
					(if (assoc 62 enx) (setq enx (subst (cons 62 256) (assoc 62 enx) enx)))
					(setq enx (subst (cons 8 lyr0) (assoc 8 enx) enx))
					(entupd (cdr (assoc -1 (entmod enx))))
				)
			)		
		)
		(vla-Regen acDoc acActiveViewport)
		(vla-ZoomExtents (vlax-get-acad-object))
	)
)
(princ)
);| defun |; (vl-load-com) (princ)

If that doesn't work (to reset the color), then change this row:

(if (assoc 62 enx) (setq enx (subst (cons 62 256) (assoc 62 enx) enx)))

To:

(vl-catch-all-apply (function 'vla-put-Color) (list (vlax-ename->vla-object e) acByLayer))

Edited October 5, 2016 by Grrr

October 5, 2016

Thank you very much for that! It is almost there, the only problem now is that it puts the lineweight 0.50mm lines onto the "0" layer but I need them to go onto the '0existing'

Everything else is fine, thanks again.

October 5, 2016

Thank you very much for that! It is almost there, the only problem now is that it puts the lineweight 0.50mm lines onto the "0" layer but I need them to go onto the '0existing'

Everything else is fine, thanks again.

Sorry for the misunderstanding, I modified the code in my previous post, try it.

October 6, 2016

Sorry for the misunderstanding, I modified the code in my previous post, try it.

That works so thank you very much! I will use this now to try and teach myself but you have been a big help.

Sorry to be cheeky but I have been using this today and there are just a couple more things that have cropped up that I didn't think to ask before.....

1. On the 'Layer 1' items that are moved onto the "0" layer there are sometimes some lines in 'Cyan' colour that need to be deleted.

2. There are also some other lines on 'Layer 1' that are 'Color 35'. These need to be moved onto the '0' layer as the current routine does but the colour needs changing from 'Color 35' to 'By Layer'.

If both of these could be added at the end of the current routine that would be great!

October 6, 2016

Your request starts to spin my head, however try this:

(defun C:test ( / lyr1 lyr0 acDoc emakeLay SSX i e enx ce )

(setq lyr1 "Layer 1");<- type your layername here
(setq lyr0 "0existing");<- type your layername for lineweight 0.50mm

(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
(defun emakeLay (nm)
	(or (tblsearch "LAYER" nm)
		(progn
			(alert (strcat "\nLayer \"" nm "\" does not exist, creating it!"))
			(entmakex (list (cons 0 "LAYER")(cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 nm)(cons 70 0)))
		)
	)
	(princ)
); defun emakeLay
(mapcar 'emakeLay (list lyr0 lyr1))

(if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
	(progn
		(setq ce (getvar 'cmdecho))
		(setvar 'cmdecho 0)
		(command "_.SCALE" SSX "" '(0. 0. 0.) 5)
		(repeat (setq i (sslength SSX))
			(setq e (ssname SSX (setq i (1- i))))
			(setq enx (entget e))
			(cond 
				((= lyr1 (cdr (assoc 8 enx)))
					(setq enx (subst (cons 8 "0") (assoc 8 enx) enx))
				)
				((= (cdr (assoc 62 enx)) 35)
					(setq 
						enx (subst (cons 8 lyr0) (assoc 8 enx) enx)
						enx (subst (cons 62 256) (assoc 62 enx) enx)
					)
				)
				((= (cdr (assoc 370 enx)) 50)
					(if (and (assoc 62 enx) (/= (cdr (assoc 62 enx)) 4)) 
						(setq enx (subst (cons 62 256) (assoc 62 enx) enx))
					)
					(setq enx (subst (cons 8 lyr0) (assoc 8 enx) enx))
				)
				((= (cdr (assoc 62 enx)) 4)
					(entdel e)
				)
			); cond
			(entupd (cdr (assoc -1 (entmod enx))))
		)
		(vla-Regen acDoc acActiveViewport)
		(vla-ZoomExtents (vlax-get-acad-object))
		(if ce (setvar 'cmdecho ce))
	)
)
(princ)
);| defun |; (vl-load-com) (princ)

October 7, 2016

Your request starts to spin my head, however try this:

(defun C:test ( / lyr1 lyr0 acDoc emakeLay SSX i e enx ce )
   
   (setq lyr1 "Layer 1");<- type your layername here
   (setq lyr0 "0existing");<- type your layername for lineweight 0.50mm
   
   (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
   (vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
   (defun emakeLay (nm)
       (or (tblsearch "LAYER" nm)
           (progn
               (alert (strcat "\nLayer \"" nm "\" does not exist, creating it!"))
               (entmakex (list (cons 0 "LAYER")(cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 nm)(cons 70 0)))
           )
       )
       (princ)
   ); defun emakeLay
   (mapcar 'emakeLay (list lyr0 lyr1))

   (if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
       (progn
           (setq ce (getvar 'cmdecho))
           (setvar 'cmdecho 0)
           (command "_.SCALE" SSX "" '(0. 0. 0.) 5)
           (repeat (setq i (sslength SSX))
               (setq e (ssname SSX (setq i (1- i))))
               (setq enx (entget e))
               (cond 
                   ((= lyr1 (cdr (assoc 8 enx)))
                       (setq enx (subst (cons 8 "0") (assoc 8 enx) enx))
                   )
                   ((= (cdr (assoc 62 enx)) 35)
                       (setq 
                           enx (subst (cons 8 lyr0) (assoc 8 enx) enx)
                           enx (subst (cons 62 256) (assoc 62 enx) enx)
                       )
                   )
                   ((= (cdr (assoc 370 enx)) 50)
                       (if (and (assoc 62 enx) (/= (cdr (assoc 62 enx)) 4)) 
                           (setq enx (subst (cons 62 256) (assoc 62 enx) enx))
                       )
                       (setq enx (subst (cons 8 lyr0) (assoc 8 enx) enx))
                   )
                   ((= (cdr (assoc 62 enx)) 4)
                       (entdel e)
                   )
               ); cond
               (entupd (cdr (assoc -1 (entmod enx))))
           )
           (vla-Regen acDoc acActiveViewport)
           (vla-ZoomExtents (vlax-get-acad-object))
           (if ce (setvar 'cmdecho ce))
       )
   )
   (princ)
);| defun |; (vl-load-com) (princ)

Hi, thanks for trying that but it didn't quite work (it brings up a message in the command line saying 'too many items to intersect'. It then runs the routine but puts the lineweight 0.50mm onto the "0" layer and doesn't delete the 'Cyan' colours or move the colour 35 lines onto "0".

Please don't worry though as the previous one almost does everything that I am looking for so that is still a big help!

October 7, 2016

I may messed up (cond) Try this one:

(defun C:test ( / lyr1 lyr0 acDoc emakeLay SSX i e enx ce )

(setq lyr1 "Layer 1");<- type your layername here
(setq lyr0 "0existing");<- type your layername for lineweight 0.50mm

(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
(defun emakeLay (nm)
	(or (tblsearch "LAYER" nm)
		(progn
			(alert (strcat "\nLayer \"" nm "\" does not exist, creating it!"))
			(entmakex (list (cons 0 "LAYER")(cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 nm)(cons 70 0)))
		)
	)
	(princ)
); defun emakeLay
(mapcar 'emakeLay (list lyr0 lyr1))

(if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
	(progn
		(setq ce (getvar 'cmdecho))
		(setvar 'cmdecho 0)
		(command "_.SCALE" SSX "" '(0. 0. 0.) 5)
		(repeat (setq i (sslength SSX))
			(setq e (ssname SSX (setq i (1- i))))
			(setq enx (entget e))
			(if (= lyr1 (cdr (assoc 8 enx)))
				(setq enx (subst (cons 8 "0") (assoc 8 enx) enx))
			)
			(if (= (cdr (assoc 62 enx)) 35)
				(setq 
					enx (subst (cons 8 "0") (assoc 8 enx) enx)
					enx (subst (cons 62 256) (assoc 62 enx) enx)
				)
			)
			(if (= (cdr (assoc 370 enx)) 50)
				(progn
					(if (and (assoc 62 enx) (/= (cdr (assoc 62 enx)) 4)) 
						(setq enx (subst (cons 62 256) (assoc 62 enx) enx))
					)
					(setq enx (subst (cons 8 lyr0) (assoc 8 enx) enx))
				)
			)
			(entupd (cdr (assoc -1 (entmod enx))))
			(if (= (cdr (assoc 62 enx)) 4)
				(entdel e)
			)
		)
		(vla-Regen acDoc acActiveViewport)
		(vla-ZoomExtents (vlax-get-acad-object))
		(if ce (setvar 'cmdecho ce))
	)
)
(princ)
);| defun |; (vl-load-com) (princ)

Edited October 8, 2016 by Grrr

October 7, 2016

I would have used the SELECTSIMILAR for most of this. For almost every single thing you need you could have set your settings to your requirements and simply changed the layer/color and what not.

October 8, 2016

I may messed up (cond) Try this one:

(defun C:test ( / lyr1 lyr0 acDoc emakeLay SSX i e enx ce )

(setq lyr1 "Layer 1");<- type your layername here
(setq lyr0 "0existing");<- type your layername for lineweight 0.50mm

(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vlax-map-collection (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) '(lambda (x) (vla-put-Lock x :vlax-false)))
(defun emakeLay (nm)
	(or (tblsearch "LAYER" nm)
		(progn
			(alert (strcat "\nLayer \"" nm "\" does not exist, creating it!"))
			(entmakex (list (cons 0 "LAYER")(cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 nm)(cons 70 0)))
		)
	)
	(princ)
); defun emakeLay
(mapcar 'emakeLay (list lyr0 lyr1))

(if (setq SSX (ssget "_X" (list (cons 410 (getvar 'ctab)))))
	(progn
		(setq ce (getvar 'cmdecho))
		(setvar 'cmdecho 0)
		(command "_.SCALE" SSX "" '(0. 0. 0.) 5)
		(repeat (setq i (sslength SSX))
			(setq e (ssname SSX (setq i (1- i))))
			(setq enx (entget e))
			(if (= lyr1 (cdr (assoc 8 enx)))
				(setq enx (subst (cons 8 "0") (assoc 8 enx) enx))
			)
			(if (= (cdr (assoc 62 enx)) 35)
				(setq 
					enx (subst (cons 8 lyr0) (assoc 8 enx) enx)
					enx (subst (cons 62 256) (assoc 62 enx) enx)
				)
			)
			(if (= (cdr (assoc 370 enx)) 50)
				(progn
					(if (and (assoc 62 enx) (/= (cdr (assoc 62 enx)) 4)) 
						(setq enx (subst (cons 62 256) (assoc 62 enx) enx))
					)
					(setq enx (subst (cons 8 lyr0) (assoc 8 enx) enx))
				)
			)
			(entupd (cdr (assoc -1 (entmod enx))))
			(if (= (cdr (assoc 62 enx)) 4)
				(entdel e)
			)
		)
		(vla-Regen acDoc acActiveViewport)
		(vla-ZoomExtents (vlax-get-acad-object))
		(if ce (setvar 'cmdecho ce))
	)
)
(princ)
);| defun |; (vl-load-com) (princ)

Thanks again, that is almost there!

The only thing is it puts the Colour 35 items onto the "0existing" layer instead of the "0" layer but apart from that it does everything I need!

October 8, 2016

Thanks again, that is almost there!
The only thing is it puts the Colour 35 items onto the "0existing" layer instead of the "0" layer but apart from that it does everything I need!

Corrected the code in my last post. Sorry, it was confusing with these "0" and "0existing" layer names.

October 8, 2016

Corrected the code in my last post. Sorry, it was confusing with these "0" and "0existing" layer names.

Wow thank you, that is everything that I need. Hopefully you won't here from me again!

October 8, 2016

I was following this topic, and i need a similair LISP, but instead of checking for lineweights, i need a check for linetypes.

Im trying to edit the code above myself, but i dont understand how you check for lineweight properties... i just cant find the logic in the code.

Is is easy to edit this code to:

- check all objects in the drawing...

- if something has the property : Linetype Hidden...

- change it so : Linetype Hidden2.

- and if its dashed, change it to dashed2...

entire drawing, including blocks etc... so hidden and dashed can be purged...

I need a specific check on the 'properties' part, not a check on the layermanager. (got that one solved already. :-))

October 8, 2016

I was following this topic, and i need a similair LISP, but instead of checking for lineweights, i need a check for linetypes.
Im trying to edit the code above myself, but i dont understand how you check for lineweight properties... i just cant find the logic in the code.

Is is easy to edit this code to:

- check all objects in the drawing...

- if something has the property : Linetype Hidden...

- change it so : Linetype Hidden2.

- and if its dashed, change it to dashed2...

entire drawing, including blocks etc... so hidden and dashed can be purged...

I need a specific check on the 'properties' part, not a check on the layermanager. (got that one solved already. :-))

Not sure will this work, please reply after testing it:

(defun C:test ( / blkdef e enx i lckd ssx subent subenx )
(vlax-for x (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) 
	(if (= (vla-get-Lock x) :vlax-true) 
		(progn
			(vla-put-Lock x :vlax-false)
			(setq lckd (cons x lckd))
		)
	)
)
(while (setq blkdef (tblnext "BLOCK" (not blkdef)))
	(setq subEnt (cdr (assoc -2 blkdef)))
	(while subEnt
		(setq subEnx (entget subEnt))
		(if (assoc 6 [color="red"]subEnx[/color])
			(cond
				((= (strcase (cdr (assoc 6 subEnx))) "HIDDEN")
					(setq subEnx (subst (cons 6 "HIDDEN2") (assoc 6 subEnx) subEnx))
					(entupd (cdr (assoc -1 (entmod subEnx))))
				)
				((= (strcase (cdr (assoc 6 subEnx))) "DASHED")
					(setq subEnx (subst (cons 6 "DASHED2") (assoc 6 subEnx) subEnx))
					(entupd (cdr (assoc -1 (entmod subEnx))))
				)
			); cond
		)
		(setq subEnt (entnext subEnt))
	)
               (entupd (tblobjname "BLOCK" (cdr (assoc 2 blkdef))))
)

(if (setq SSX (ssget "_X"))
	(repeat (setq i (sslength SSX))
		(setq e (ssname SSX (setq i (1- i))))
		(setq enx (entget e))
		(if (assoc 6 enx)
			(cond
				((= (strcase (cdr (assoc 6 enx))) "HIDDEN")
					(setq enx (subst (cons 6 "HIDDEN2") (assoc 6 enx) enx))
					(entupd (cdr (assoc -1 (entmod enx))))
				)
				((= (strcase (cdr (assoc 6 enx))) "DASHED")
					(setq enx (subst (cons 6 "DASHED2") (assoc 6 enx) enx))
					(entupd (cdr (assoc -1 (entmod enx))))
				)
			); cond
		)
	)
)
(if lckd (mapcar '(lambda (x)(vla-put-Lock x :vlax-true) ) lckd))
(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) [color="red"]acAllViewports[/color])
(vla-ZoomExtents (vlax-get-acad-object))
(princ)
)

Edited October 11, 2016 by Grrr

October 10, 2016

Thanks for the code Grrr!

The part of the code where the linetypes get replaced seems to work fine.

Tho... the part where it checks the contents of BLOCKS doent nothing. But doenst give an error message.

It just does not change the linetype inside the blocks.

Hope this can be fixed. :-)

October 10, 2016

Thanks for the code Grrr!
The part of the code where the linetypes get replaced seems to work fine.

Tho... the part where it checks the contents of BLOCKS doent nothing. But doenst give an error message.

It just does not change the linetype inside the blocks.

Hope this can be fixed. :-)

Hmm, I can't seem to find the problem, edited the code to regen All viewports (the red text). If it still doesn't work I will try to re-write the block iteration with visual lisp.

Sign In

LISP routine to select lineweight and scale

Recommended Posts

andy_06

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Grrr

Dadgad

andy_06

andy_06

Grrr

andy_06

Grrr

andy_06

Grrr

andy_06

Grrr

MillerMG

andy_06

Grrr

andy_06

Aftertouch

Grrr

Aftertouch

Grrr

Join the conversation

Tutorials

Forums

Activity