Lisp Routine to change Blocks Line Type

Lisp Routine to change Blocks Line Type

Irreb
Enthusiast Enthusiast
3,202 Views
6 Replies
Message 1 of 7

Lisp Routine to change Blocks Line Type

Irreb
Enthusiast
Enthusiast

Hi Everyone, i recently found online (i guess) the most useful LISP Routine ever.

This one allows to change the color of selected blocks to a specific color from 1 to 255 or ByLayer or ByBlock, for all objects inside the block regardless of weather it is a static or dynamic block.

 

(I have attached it to this post)

 

All i want to ask is this:

as i don't know how to write these LISP routines myself, can anyone help me modify this attached LISP so it does a very similar job with line type instead?
what i need it to do is:
- changing the line type to a specific one i chose or ByLayer or ByBlock
- change the scale of the new line type

one cool thing that would make it very good is if it can get the line type and scale data from a selected object and apply it to one or more selected blocks.

0 Likes
3,203 Views
6 Replies
Replies (6)
Message 2 of 7

3wood
Advisor
Advisor

You can also try CHZ20.

It can change the block subentities' linetype to ByLayer or ByBlock, also change the Linetype Scale etc.

Capture.PNG

0 Likes
Message 3 of 7

Irreb
Enthusiast
Enthusiast

Thanks for the software.
Although the software is free it appears it need a "free" subscription for one year, after which you have to subscribe to something else etc etc.

francesco0berri_0-1618614297063.png


I trust you that this program works, though i much prefer something from the community and free and that can be modified easily if necessary (just like the lisp routine i shared)

thanks for the advice anyways

0 Likes
Message 4 of 7

ВeekeeCZ
Consultant
Consultant

This should do the thing. Possibly you can comment in/out other properties -- see the semicolons.

 

(vl-load-com)

(defun c:BFixLT+S (/ *error* :fixblocknested adoc :layers-restore lst_layer lay o l c w lt lts)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (:layers-restore)
    (vla-endundomark adoc)
    (princ))
  
  (defun :layers-restore ()
    (foreach item lst_layer
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))))))
  
  (defun :fixblocknested (n / be o)
    (if (not (vl-position n lst))
      (progn
	(setq lst (cons n lst)
	      be (tblobjname "BLOCK" n))
	(while (setq be (entnext be))
	  (if (= (cdr (assoc 0 (entget be))) "INSERT")
	    (:fixblocknested (cdr (assoc 2 (entget be)))))
	  (setq o (vlax-ename->vla-object be))
;;;	  (vl-catch-all-apply 'vla-put-layer (list o l))
;;;	  (vl-catch-all-apply 'vla-put-color (list o c))
;;;	  (vl-catch-all-apply 'vla-put-lineweight (list o w))
	  (vl-catch-all-apply 'vla-put-linetype (list o lt))
	  (vl-catch-all-apply 'vla-put-linetypescale (list o lts))
	  ))))
  
  ;; -------------------------------------------------------------------------------------------
  
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)
  (vlax-for item (vla-get-layers adoc)
    (setq lst_layer (cons (list item
				(cons "lock" (vla-get-lock item))
				(cons "freeze" (vla-get-freeze item)))
			  lst_layer))
    (vla-put-lock item :vlax-false)
    (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
  
  (setq s (ssget '((0 . "INSERT"))))
  
  (if (and (setq o (car (entsel "\nSelect a source for LT and LTS: ")))
	   (setq o (vlax-ename->vla-object o))
	   (setq l (vla-get-layer o))
	   (setq c (vla-get-color o))
	   (setq w (vla-get-lineweight o))
	   (setq lt (vla-get-linetype o))
	   (setq lts (vla-get-linetypescale o))
	   )
    (if s
      (repeat (setq i (sslength s))
	(setq name (cdr (assoc 2 (entget (ssname s (setq i (1- i)))))))
	(:fixblocknested name))
;;;      (progn
;;;	(princ "\nFixing all blocks...")
;;;	(vlax-for blk (vla-get-blocks adoc)
;;;	  (if (and (equal (vla-get-islayout blk) :vlax-false)
;;;		   (equal (vla-get-isxref blk) :vlax-false)
;;;		   )
;;;	    (vlax-for o blk
;;;	      (vl-catch-all-apply 'vla-put-layer (list o l))
;;;	      (vl-catch-all-apply 'vla-put-color (list o c))
;;;	      (vl-catch-all-apply 'vla-put-lineweight (list o w))
;;;	      (vl-catch-all-apply 'vla-put-linetype (list o lt))
;;;	      (vl-catch-all-apply 'vla-put-linetypescale (list o lts))
;;;	      ))))
    ))
  (:layers-restore)
  (vla-endundomark adoc)
  (command "_.regenall")
  (princ)
  )

 

0 Likes
Message 5 of 7

Irreb
Enthusiast
Enthusiast

Hi,

thanks for the routine. not sure it is working..or maybe i am not doing it correctly.

 

I loaded the lisp and run the command:

-> "BFIXLT+S"

-> select the block reference

-> hit enter

-> select the line of reference with the the line type and scale i am looing for

-> the model regenerate automatically and nothing has changed..

am i doing something wrong?

francesco0berri_0-1618839654758.png

 

edit:
only the line scale has changed, line type stays the same as the original.

0 Likes
Message 6 of 7

ВeekeeCZ
Consultant
Consultant

Yeah, I can imagine. It takes object properties, not layer properties.

0 Likes
Message 7 of 7

Irreb
Enthusiast
Enthusiast

I don't think i understand your answer.
Maybe i didn't explain properly what i am looking for.

 

what I would like is something that works like this:

 

-> insert command in command line

-> select the line or other object which has the line type and scale i want to match the block reference to

-> hit enter

-> select one or more block references of which i want to change all line type and scales of all objects in it

-> done

 

basically the "MATCHPROP" command, but that works toward any block reference instead of single elements.