Lisp: Select objects w/ Linetype BYLAYER, change LTSCALE

[billdunham3068]

I am trying to write a lisp to complete the following:

1. Select objects where the linetype is set BYLAYER, with a specific linetype (e.g. "CENTER")
2. Change/update the LTSCALE of those specific objects (e.g. make them 1.0)

I found it was quite easy for me to select all objects with a specific linetype by object and update the properties. For example:

(setq ss (ssget "X" '((6 . "CENTER"))))
(if (/= ss nil)
(progn
(command "chprop" ss "" "ltype" "CENTER2" "")
(command "chprop" ss "" "ltscale" "1" "")
); progn
(prompt "\nCENTER linetype not found\n")

I can update all linetypes set to BYLAYER to using the following code, but it doesn't update the LTSCALE as well:

(vlax-for layer (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= "CENTER" (vla-get-linetype layer))(vla-put-Linetype layer "CENTER2")))

I'd like to be able to modify the code above to both update the Linetype and the LtScale of the affected objects. I'm admittedly not very skilled with programming and writing lisps, but I've managed to get by following the many examples and generous assistance offered to others with similar queries on these forums. I would really appreciate any help to both understand and complete the code, just something simple that I can follow with my limited knowledge.

Thank you!

[ВeekeeCZ]

Not sure if this is what you want... try and see. I wrote 2 versions... read the comments.

(defun c:LTCenter1 ( / s i e l)

  (if (setq s (ssget "_A" (list '(6 . "CENTER") (cons 410 (getvar 'ctab)))))
    (command "_.chprop" s "" "_ltype" "CENTER2" "ltscale" 1 ""))

  (if (and (setq s (ssget "_A" (list '(6 . "BYLAYER") (cons 410 (getvar 'ctab)))))
	   (vl-cmdf "_.chprop" s "" "ltscale" 1 "")) ; change LTScale of each object
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    l (cdr (assoc 8 (entget e))))
      (if (= "CENTER" (cdr (assoc 6 (tblsearch "LAYER" l))))
	(command "_.-layer" "ltype" "CENTER2" l "")))) ; change layer's linetype

  (princ)
  )

(defun c:LTCenter2 ( / s i e)

  (if (setq s (ssget "_A" (list '(6 . "CENTER") (cons 410 (getvar 'ctab))))) 
    (command "_.chprop" s "" "_ltype" "CENTER2" "ltscale" 1 ""))

  (if (setq s (ssget "_A" (list '(6 . "BYLAYER") (cons 410 (getvar 'ctab)))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i))))
      (if (not (= "CENTER" (cdr (assoc 6 (tblsearch "LAYER" (cdr (assoc 8 (entget e)))))))) 
	(ssdel e s))))

  (if (and s (> (sslength s) 0))
    (command "_.chprop" s "" "_ltype" "CENTER2" "ltscale" 1 ""))  ; change just object's properties ltscale and linetype. the won't change a layer property.

  (princ)
  )

[billdunham3068]

@ВeekeeCZ,

Thank you very much for the quick reply!

I posted a lengthy response a short while ago, and to my horror it seemingly vanished. I'm assuming you never saw it, so I will try and re-type it all...

Your functions work perfectly to do what I outlined. I realize now that I probably should've provided more details in my original post but because of my limited lisp knowledge and not wanting to make it more confusing, I was hoping I could try and learn by example and expand it.

Could you please review the full scope of what I'm trying to do? I'd really appreciate your help.

The ultimate goal is to be able to update a series of linetypes. For simplicity, please see the table below:

LTYP1 -> change to LTYP100
LTYP2 -> change to LTYP200
LTYP3 -> change to LTYP300
LTYP4 -> change to LTYP400
LTYP5 -> change to LTYP500
LTYP6 -> change to LTYP600
LTYP7 -> change to LTYP700

In reality, I realize the last step would be updating setting the ltscale to 1 for all of the new LTYP "X00" linetypes. This is because the new linetypes I've created are defined at 1:1 scale, where the old ones had various ltscales applied. I don't want to update any other linetype scales in the drawing, such as other standard or custom linetypes that may exist, since they may need to retain their own properties to plot properly.

Below is the code I had so far, mixed with my comments/questions.

(defun C:UPDATELTYP ()


(initget "Y N")
(setq option (getkword "\nThis function will update all LTYP "X" Linetypes in the drawing.\nDo you wish to continue? [Y/N] <N>: ")) 

(if (= option "Y")


(progn

   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
   ; STEP 1: load the new linetypes if they are not found in the drawing
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
   (foreach lt '("LTYP100" "LTYP200" "LTYP300" "LTYP400" "LTYP500" "LTYP600" "LTYP700")
      (if (not (tblsearch "ltype" lt))(command "_.-linetype" "_l" lt "LTYP.lin" ""))) 


   (vl-load-com)


   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
   ; STEP 2: on my own, I only know how to use the code below, for updating 
   ; the layer linetypes one at a time:
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
   (vlax-for layer (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object)))
      (if (= "LTYP1" (vla-get-linetype layer))(vla-put-Linetype layer "LTYP100")))
   ; I would repeat the code above for each affected linetype by layer. 
   ; I would prefer a list/array!

 
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
   ; STEP 3: for linetypes set by object property, I can use SSGET but I 
   ; don't know how to make it work within a loop
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
   (setq ss (ssget "X" '((6 . "LTYP1"))))
   (if (/= ss nil)
       (progn 
           (command "_.chprop" ss "" "_ltype" "LTYP100" "")
       ); progn
       (prompt "\nLTYP1 not found\n")
   ); if


   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
   ; STEP 4: the last step would be to update the ltscale of only the 
   ; updated linetypes defined above. Again, I know how to use SSGET for 
   ; selecting object by linetype one at a time, but not in a loop for all,
   ; and FOREACH won't work.
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 


(prompt "\nLTYP Linetype Conversion Complete!")

); progn

(prompt "\nLTYP Linetype Conversion: *CANCELLED*")

); if

(princ)

); defun

r

[ВeekeeCZ]

Are there any affected entities inside blocks? Also other spaces than current? 

How about the current state of layers - are any frozen or locked? What if they do, ignore them? or process them too?

Also, your wording is still unclear to me.

It's clear, that if an object has assigned one of those ltypes, the ltypes would be updated and so it's ltscale to 1.

But if talking layers w/ lt - am I right thinking that we need update ltscale to 1 only to those objects w/ lt bylayer? The question is whether there is the possibility that some objects in those layers have assigned different ltype with different ltscale.

btw I have your original reply in my mailbox. It probably fell to the site's spam filter. You could ask the moderator to get it back (and wait until tomorrow).

[billdunham3068]

@ВeekeeCZ,

Please see my responses below, in blue font.

Are there any affected entities inside blocks? Also other spaces than current? 

How about the current state of layers - are any frozen or locked? What if they do, ignore them? or process them too?

• All objects are in model space for these drawings
• Updating block elements would be a priority for me, but frozen or locked layers could be ignored if it gets too complicated. I've been struggling to understand how to write a basic function to investigate the entities inside of blocks, so I'm willing to sacrifice it for the lisp since I can't do it. I am working with a lot of drawing conversions between AutoCAD DWG and Microstation DGN, and for DWG files being converted to DGN, the current process is to explode the blocks to avoid certain conversion issues. However, if you would be willing to show me how to include updating entities in blocks, I would be so very grateful!

Also, your wording is still unclear to me.

It's clear, that if an object has assigned one of those ltypes, the ltypes would be updated and so it's ltscale to 1.

But if talking layers w/ lt - am I right thinking that we need update ltscale to 1 only to those objects w/ lt bylayer? The question is whether there is the possibility that some objects in those layers have assigned different ltype with different ltscale.

My apologies, hopefully I can explain the obect ltScale issue better below.

So in Step 4 (the final step), I would like to reset the ltscale of all the linetypes in the drawing that are newly defined as LTYP100, LTYP200... to LTYP700. This will apply to all objects with only these linetypes I defined, whether assigned as a ByLayer override, or by object property. Does this make sense?

A lot of the drawings I'm reviewing are on layers with a linetype override (e.g. ByLayer set to "LTYP100"), but objects on those layers could either be set to ByLayer or different linetypes.

So, I could have a layer defined with ltype as "LTYP100", and there could be objects on that layer with multiple linetypes. It's admittedly a mess, and not how I personally would do the drafting but seemingly a legacy issue from old Microstation files with limited layers available. These drawings may be converted back to DGN anyhow.

btw I have your original reply in my mailbox. It probably fell to the site's spam filter. You could ask the moderator to get it back (and wait until tomorrow).

Understood, thanks for letting me know. Again, your help is very much appreciated!

[ВeekeeCZ]

Here's the quick one. If any issues, post a test drawing and I'll take a look tomorrow.

(vl-load-com)
;; beekeecz 21-08-01

(defun c:LtTranslate (/ *error* acdoc lst lto ltn s i e o lt lys)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg)))
    (vla-endundomark acdoc)
    (princ))
  
  (if (not acdoc) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
  (vla-startundomark acdoc)
  
  (setq lst '(("BORDER" . "BORDER2") ; case-sensitive!
	      ("CENTER" . "CENTER2")
	      ("LTYP3" . "LTYP300")
	      ("LTYP4" . "LTYP400")
	      ("LTYP5" . "LTYP500")
	      ("LTYP6" . "LTYP600")
	      ("LTYP7" . "LTYP700"))
	lto (mapcar 'car lst)
	ltn (mapcar 'cdr lst))
  
  (if (or (findfile "ltyp.lin")
	  (prompt "\nError: ltyp.lin not found!"))
    (foreach lt ltn
      (if (not (tblsearch "ltype" lt)) (progn (getvar 'cmdecho 0) (command "_.-linetype" "_l" lt "LTYP.lin" "") (getvar 'cmdecho 1)))))
  
  (if (vl-position (getvar 'celtype) lto)
    (setvar 'celtype "ByLayer"))
  
  (vlax-for layer (vla-get-layers acdoc)
    (if (vl-position (setq lt (vla-get-linetype layer)) lto)
      (progn
	(vla-put-Linetype layer (cdr (assoc lt lst)))
	(setq lys (cons (vla-get-name layer) lys)))))
  
  (if (setq s (ssget "_X"))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i))))
      (if (setq lt (cdr (assoc 6 (entget e))))
	(if (vl-position lt lto)
	  (progn
	    (vla-put-linetype (setq o (vlax-ename->vla-object e)) (cdr (assoc lt lst)))
	    (vla-put-linetypescale o 1.)))
	(if (vl-position (cdr (assoc 8 (entget e))) lys)
	  (vla-put-linetypescale o 1.)))))
  
  (vlax-for blk (vla-get-blocks acdoc)
    (if (and (equal (vla-get-islayout blk) :vlax-false)
	     (equal (vla-get-isxref blk) :vlax-false)
	     )
      (vlax-for o blk
	(if (vl-position (setq lt (vla-get-linetype o)) lto)
	  (progn
	    (vl-catch-all-apply 'vla-put-linetype (list o (cdr (assoc lt lst))))
	    (vl-catch-all-apply 'vla-put-linetypescale (list o 1.))))
	(if (and (= (vla-get-linetype o) "ByLayer")
		 (vl-position (vla-get-layer o) lys))
	  (vl-catch-all-apply 'vla-put-linetypescale (list o 1.))))))
  
  (command "_.-PURGE" "_lt" (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) lto)) "_n")
  
  (vla-regen acdoc AcallViewports)
  (vla-endundomark acdoc)
  (princ)
  )

[billdunham3068]

Thank you!!

I ran your code, but in my tests it wasn't updating the linetype scale where the linetypes were assigned BYLAYER.

Could you please take a look at this test drawing, and let me know?

Your code is very effecient and easy for me to follow, this is a great learning experience for me. There is so much to learn about programming lisps...

The existing linetypes I'm going to change in this test file are the default Microstation DGN Styles (1 through 7) that are exported to DWG. I modified the 'lst' to indicate these linetypes. Please see the change required below. 

  (setq lst '(("DGN Style 1" . "LTYP100") ; case-sensitive!
	      ("DGN Style 2" . "LTYP200")
	      ("DGN Style 3" . "LTYP300")
	      ("DGN Style 4" . "LTYP400")
	      ("DGN Style 5" . "LTYP500")
	      ("DGN Style 6" . "LTYP600")
	      ("DGN Style 7" . "LTYP700"))
	lto (mapcar 'car lst)
	ltn (mapcar 'cdr lst))

[ВeekeeCZ · Accepted solution]

Ok, thanks for the dwg. Now it seems to be working fine. 

(vl-load-com)
;; beekeecz 21-08-01

(defun c:UpdateLtyp (/ *error* cmd stl acdoc :main-set-function :LayersAllUnlockAndThaw :LayersRestore lst lto ltn s i e o lt lys)

  ;-----
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if cmd (setvar 'cmdecho cmd))
    (if stl (:LayersRestore stl))
    (vla-endundomark acdoc)
    (vla-regen acdoc AcallViewports)
    (princ))
  
  ;-----
  (defun :main-set-function (o)
    (if (= (setq lt (vla-get-linetype o)) "ByLayer")
      (if (vl-position (vla-get-layer o) lys)
	(vl-catch-all-apply 'vla-put-linetypescale (list o 1.)))
      (if (vl-position lt (append lto ltn))
	(progn
	  (vl-catch-all-apply 'vla-put-linetype (list o (cdr (assoc lt lst))))
	  (vl-catch-all-apply 'vla-put-linetypescale (list o 1.))))))
  
  ;-----
  (defun :LayersAllUnlockAndThaw (doc / lst)
    (vlax-for itm (vla-get-layers doc)
      (setq lst (cons (list itm
			    (cons "lock" (vla-get-lock itm))
			    (cons "freeze" (vla-get-freeze itm)))
		      lst))
      (vla-put-lock itm :vlax-false)
      (vl-catch-all-apply '(lambda () (vla-put-freeze itm :vlax-false))))
    lst)
  
  ;-----
  (defun :LayersRestore (lst)
    (foreach itm lst
      (vla-put-lock (car itm) (cdr (assoc "lock" (cdr itm))))
      (vl-catch-all-apply '(lambda () (vla-put-freeze (car itm) (cdr (assoc "freeze" (cdr itm))))))))
  
  ; -------------------------------------------------------------------------------------------------
  
  (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object))))
  (vla-startundomark acdoc)
  
  (setq lst 				; case-sensitive!
	 '(("DGN Style 1" . "LTYP100")
	   ("DGN Style 2" . "LTYP200")
	   ("DGN Style 3" . "LTYP300")
	   ("DGN Style 4" . "LTYP400")
	   ("DGN Style 5" . "LTYP500")
	   ("DGN Style 6" . "LTYP600")
	   ("DGN Style 7" . "LTYP700"))
	)
  
  (setq lto (mapcar 'car lst)
	ltn (mapcar 'cdr lst))
  
  (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0)
  (setq stl (:LayersAllUnlockAndThaw acdoc))
  
  (if (or (findfile "ltyp.lin")
	  (prompt "\nError: 'ltyp.lin' file not found!"))
    (foreach lt ltn
      (if (not (tblsearch "ltype" lt)) (command "_.-linetype" "_l" lt "LTYP.lin" ""))))
  
  (vlax-for layer (vla-get-layers acdoc)
    (if (vl-position (setq lt (vla-get-linetype layer)) lto)
      (progn
	(vla-put-Linetype layer (cdr (assoc lt lst)))
	(setq lys (cons (vla-get-name layer) lys)))))
  
  (if (setq s (ssget "_X"))
    (repeat (setq i (sslength s))
      (:main-set-function (vlax-ename->vla-object (ssname s (setq i (1- i)))))))
  
  (vlax-for blk (vla-get-blocks acdoc)
    (if (and (equal (vla-get-islayout blk) :vlax-false)
	     (equal (vla-get-isxref blk) :vlax-false)
	     )
      (vlax-for o blk
	(:main-set-function o))))
  
  (if (vl-position (getvar 'celtype) lto) (setvar 'celtype "ByLayer"))
  (command "_.-PURGE" "_lt" (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) lto)) "_n")
  (*error* "end")
  )

[billdunham3068]

Wow, this is absolutely brilliant - thank you so much!!! 🕺🕺🕺

I will mark this as resolved. I really appreciate your time and effort to help me with this, and to generate and share such a complete and elegant solution. I wouldn't have been surprised if someone else had told me to "come back and post after I passed LISP 101".

btw, I added a Yes/No prompt at the very beginning of your code. I don't know if it's really necessary but I usually include it in my basic functions, just in case I change my mind and want to cancel.

  ;;;;;;
  (initget "Y N")
  (setq option (getkword "\nThis function will update all the old DGN Styles (1 to 7)
     with redfined linetypes.\nDo you wish to continue? [Y/N] <N>: ")) 

  (if (= option "N")(quit))
  ;;;;;;

[ВeekeeCZ]

---

@billdunham3068 wrote:

... btw, I added a Yes/No prompt at the very beginning of your code. I don't know if it's really necessary but I usually include it in my basic functions, just in case I change my mind and want to cancel.

  ;;;;;;
  (initget "Y N")
  (setq option (getkword "\nThis function will update all the old DGN Styles (1 to 7)
     with redfined linetypes.\nDo you wish to continue? [Y/N] <N>: ")) 

  (if (= option "N")(quit))
  ;;;;;;

---

This will not work for the <N> enter option.  You need to have (if (/= option "Y") (quit))...

But personally, I would flip the option to <Yes> under <enter> key. 

[billdunham3068]

I updated the Yes/No prompt, thanks again for your feedback 👍