Lisp to update Lineweights (layers, objects including inside blocks)

billdunham3068 · ‎08-03-2021

I've been working to create a lisp to update all the lineweights in a drawing that are assigned to existing layers and existing objects (including objects contained in blocks), with different values. I have some code (see below) where I would like some expert advice, if I made a significant error even though it seems to work in my testing?

I'm currently reviewing a lot of AutoCAD DWG drawings (they tend to be very old) that are imported to/exported from Microstation DGN. These drawings aren't plotted based on color dependancy for lineweight assignments, nor are properties always assigned and controlled by layer. For example, hundreds of text objects on a TEXT layer may have independant object colors and lineweights.

I've had some excellent help and feedback with my other recent queries on this forum. Regarding this lineweight issue, I was able to compile my own lisp starting awhile back, but it only worked for layers and objects not confined in blocks. I started with SSGET functions (of which I was more familiar) for objects, then tried to learn about and apply VLA/VLAX to update the layers. I've decided to revisit the blocks issue when I saw examples of other code using the layers and blocks collection, and I thought I might be able to finally do this.

Please see my current code below. It's not fancy or efficient, but the best I could do on my own and right now I stripped it down just for testing. What really puzzles me is the unexpected outcome - the part of the code I thought would work only for blocks, actually seems to update all objects in the drawing, whether or not they are confined in blocks. Is this a "happy little accident"? I'm concerned that if it's a fluke, and the code isn't proper, could I run into problems in the future with different drawing files?

Thanks in advance for your feedback.

;;;  --- BEGIN CODE

(vl-load-com)

(defun C:UpdateLwts ()


  ;; Cycle through all entities within a block
  (vlax-for blk blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))
      (vlax-for obj blk

      (if (= (vla-get-Lineweight obj) 40) (vla-put-Lineweight obj 70))   ; if DGN 3
      (if (= (vla-get-Lineweight obj) 30) (vla-put-Lineweight obj 50))   ; if DGN 2
      (if (= (vla-get-Lineweight obj) 13) (vla-put-Lineweight obj 40))   ; if DGN 1
      (if (= (vla-get-Lineweight obj) 5) (vla-put-Lineweight obj 25))    ; if DGN 0
      (if (= (vla-get-Lineweight obj) 0) (vla-put-Lineweight obj 25))    ; if 0.00 mm
      (if (= (vla-get-Lineweight obj) -3) (vla-put-Lineweight obj 25))   ; if Default

      ) ; end of vlax-for obj blk
  ) ; end of vlax-for blk blocks
 

  ;; Cycle through all layers in the drawing
  (vlax-for layer (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 
      (if (= 40 (vla-get-Lineweight layer))(vla-put-Lineweight layer 70)) ; if DGN 3
      (if (= 30 (vla-get-Lineweight layer))(vla-put-Lineweight layer 50)) ; if DGN 2
      (if (= 13 (vla-get-Lineweight layer))(vla-put-Lineweight layer 40)) ; if DGN 1
      (if (= 5 (vla-get-Lineweight layer))(vla-put-Lineweight layer 25)) ; if DGN 0
      (if (= 0 (vla-get-Lineweight layer))(vla-put-Lineweight layer 25)) ; if 0.00 mm
      (if (= -3 (vla-get-Lineweight layer))(vla-put-Lineweight layer 25)) ; if Default
  
  ) ; end of vlax-for layer

  (princ)

); defun

pbejse · ‎08-03-2021

Example If you want just blocks

(vlax-for b (vla-get-blocks
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
    (if (and
	  (= (vla-get-islayout b) :vlax-false)		;<-- not modelspace|paperspace|NOT layouts
	  (= (vla-get-IsXRef b) :vlax-false)		;<-- Not an XREF
	  (not (wcmatch (vla-get-name b) "`*D*,`*U*"))	;<-- Not Dimension / Dynamic block Anonymous Names
	  )
      (print (vla-get-name b))))

HTH

billdunham3068 · ‎08-04-2021

@pbejse

Thanks for you reply and your feedback. That's very helpful to know how to isolate only blocks.

What I wanted was to complete the lisp to update the lineweights for all objects in the drawing, in any viewport. I thought I would need to separate steps or functions:

for updating free elements,
for updating objects inside of blocks, including attributes, and
for layers.

I see now that I will need some help to fix my code, since text attributes in a block would also need to be updated and aren't working in further tests. I'd appreciate any additional help.

pbejse · ‎08-04-2021

@billdunham3068 wrote:

..What I wanted was to complete the lisp to update the lineweights for all objects in the drawing,

A demo to process ALL items [ Excluding xref of course ]

(defun c:Lwt_utility ( / aDoc layers aclayer status lwt Laylist ToBeAttsync f )
;;;		pBe Aug 2021		;;
(setq aDoc    (vla-get-ActiveDocument (vlax-get-acad-object))
      layers  (vla-get-layers adoc)
      aclayer (vla-get-name (vla-get-ActiveLayer adoc))
      status  '("LayerOn" "lock" "Freeze")
      lwt 	'((40 . 70)(30 . 50)(13 . 40)(5 . 25)(0 . 25)(-3 . 25))
)

(vlax-for itm	layers
    (if (setq f (assoc (vla-get-Lineweight itm) lwt))
		  (vla-put-Lineweight itm (cdr f))
		  )
;; 		Make a list of current layer status 		;;
(setq  Laylist (cons
	    	(list itm
			  (mapcar '(lambda (p)(vlax-get itm p)
				   )
				  status
			  )
		    )
	    Laylist
	  )
	)
  
;; 			Unlock | Switched Layer ON | Thaw 			;;
    (mapcar '(lambda (pr v)
		       (vlax-put itm pr v)
	       )
	    status (if (eq (Vla-get-name itm) aclayer)
			   '(-1 0) '(-1 0 0 ))
	  )
    
    )
		      
 ;; 		Cycle through all entities 			;;
  (vlax-for blk (Vla-get-blocks aDoc)
	(if	
	   (= (vla-get-IsXRef blk) :vlax-false)	;<-- Not an XREF	
	      (vlax-for obj blk			
		(if (And
		      (vlax-write-enabled-p obj)
		      (vlax-property-available-p obj "Lineweight")
		      (setq f (assoc (vla-get-Lineweight obj) lwt)))
		  		(vla-put-Lineweight obj (cdr f))
	  	)
;;		Buidling a list of blocks with attributes		
	(if (and
		  (eq (vla-get-ObjectName obj) "AcDbBlockReference")
		  (minusp (Vlax-get obj 'HasAttributes))
		  (not (member (vla-get-EffectiveName obj) ToBeAttsync )))
		 	(setq ToBeAttsync (vl-list* "," (vla-get-EffectiveName obj) ToBeAttsync)))
	      )
	  )
    )

;; 			Revert to orignal layer Status 				;;
  (foreach rl Laylist
	(setq layeritem (car rl))
  	(if (not (vl-catch-all-error-p
  			(vl-catch-all-apply 'vla-get-name (list layeritem))))
  		(mapcar '(lambda (j k)
			   (vlax-put layeritem j k))
			(if (eq (Vla-get-name layeritem) aclayer)
			  (list (Car status)(cadr status)) status)
				(cadr rl)))
  )
		      
;;		need to invoke 'Attsync to update attributes			;;

	(vl-cmdf "_.attsync" "_N" (apply 'strcat (cdr ToBeAttsync)))
  	(vla-regen aDoc acallviewports)
  	(princ)
      )

HTH

ВeekeeCZ · ‎08-05-2021

Just a quick adjustment of the LT routine to work with LWs just you to see changes in familiar code...

But @pbejse 's routine works the same way plus covers attributes...

(defun c:UpdateLWeight (/ *error* cmd stl acdoc :main-set-function :LayersAllUnlockAndThaw :LayersRestore lst lwo lwn s i e o lw 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 (vl-position (setq lw (vla-get-Lineweight o)) lwo)
      (vla-put-Lineweight o (cdr (assoc lw lst)))))
  
  ;-----
  (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!
	 '((40 . 70)
	   (30 . 50)
	   (13 . 40)
	   (5 . 40)
	   (0 . 25)
	   (-3 . 25))
	)
  
  (setq lwo (mapcar 'car lst)
	lwn (mapcar 'cdr lst))
  
  (setq cmd (getvar 'cmdecho)) (setvar 'cmdecho 0)
  (setq stl (:LayersAllUnlockAndThaw acdoc))
    
  (vlax-for layer (vla-get-layers acdoc)
    (if (vl-position (setq lw (vla-get-Lineweight layer)) lwo)
      (vla-put-Lineweight layer (cdr (assoc lw lst)))))
  
  (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))))
  
  (*error* "end")
  )

ronjonp · ‎08-05-2021

@billdunham3068 FWIW, your if statements could be consolidated to this:

(vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for obj	blk
    (if	(setq v	(cond ((= (vla-get-lineweight obj) 40) 70)
		      ((= (vla-get-lineweight obj) 30) 50)
		      ((= (vla-get-lineweight obj) 13) 40)
		      ((member (vla-get-lineweight obj) '(-3 0 5)) 25)
		)
	)
      (vla-put-lineweight obj v)
    )
  )					; end of vlax-for obj blk
)					; end of vlax-for blk blocks

And to process only blocks:

(vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
  ;; This only processes blocks ( excluding anons dims tables etc... )
  (if (and (= 0 (vlax-get blk 'islayout) (vlax-get blk 'isxref))
	   (not (wcmatch (vlax-get blk 'name) "`**"))
      )
    (vlax-for obj blk
      (if (setq	v (cond	((= (vla-get-lineweight obj) 40) 70)
			((= (vla-get-lineweight obj) 30) 50)
			((= (vla-get-lineweight obj) 13) 40)
			((member (vla-get-lineweight obj) '(-3 0 5)) 25)
		  )
	  )
	(vla-put-lineweight obj v)
      )
    )
  )					; end of vlax-for obj blk
)					; end of vlax-for blk blocks

timothy_crouse · ‎09-17-2022

Any chance one of you folks could modify the code to work on viewport xref lineweights too?

0.40mm >> 0.30mm

0.30mm >> 0.20mm

0.20mm >> 0.15mm

0.15mm >> 0.09mm

Thank You

-Tim C.

Sea-Haven · ‎09-17-2022

Posted a suggestion about using CTB's did this not solve your problem ?

Request For Lisp - Set Selected Viewport Lineweights - Autodesk Community - AutoCAD

timothy_crouse · ‎09-19-2022

We use STBs not CTBs. The STB uses object lineweights that is why I want to create viewport overrides by changing lineweights.

-Tim

ВeekeeCZ · ‎09-19-2022

Possibly like this.

(vl-load-com)

(defun c:XrefVPSlim ( / l :table s i n e )
  
  (setq l '((40 . 0.3) (30 . 0.2) (20 . 0.15) (15 . 0.09)))
  
  (defun :table (s x / d r)
    (while (setq d (tblnext s (null d)))
      (setq n (cdr (assoc 2 d)))
      (if (wcmatch n (strcat x "|*"))
	(setq r (cons n r))))
    r)
  
  (princ "Start within VP active, select XREFs... ")
  (if (and (setq s (ssget '((0 . "INSERT"))))
	   (not (command "_.vplayer"))
	   )
    (repeat (setq i (sslength s))
      (setq n (cdr (assoc 2 (entget (ssname s (setq i (1- 1)))))))
      (foreach y (:table "layer" n)
	(setq e (tblobjname "layer" y))
	(if (and (not (vl-catch-all-error-p (setq w (vl-catch-all-apply 'getpropertyvalue (list e "LineWeightOverride")))))
		 (assoc w l)
		 )
	  ;; (vl-catch-all-apply 'setpropertyvalue (list e "LineWeightOverride" (cdr (assoc r l)))) CAUSING CRASH !!
	  (command "_lw" (cdr (assoc w l)) y "_c")))))
  (if (> (getvar 'cmdactive) 0) (command ""))
  (princ)
  )

timothy_crouse · ‎09-19-2022

What is the intended way to run the lisp?

Meaning do I run the lisp then select a viewport or

do I run the lisp while inside a viewport.

Thanks

-Tim C.