A linetype lisp problem

A linetype lisp problem

tofumen0012
Participant Participant
282 Views
2 Replies
Message 1 of 3

A linetype lisp problem

tofumen0012
Participant
Participant

 

 

;-------- start of code ----

(defun c:ltypetoent (/ n sel entity name i)
     (setq i 0 n 0)
     (princ "\n Select entities to analyze ")
     (setq sel (ssget))
     (setq n (sslength sel))
     (repeat n
          (setq entity (ssname sel i))
          (setq name (entget entity))
          (if (not (assoc 6 name))
               (progn
                    (setq layer (cdr (assoc 8 name)))
     (setq layerinf (tblsearch "LAYER" layer))
     (setq layerltype (cdr (assoc 6 layerinf)))
     (setq name (append name (list (cons 6 layerltype))))
     (entmod name)
     (entupd entity)
               )
          )
          (setq i (+ 1 i))
     )
)
(princ "\n Type LTYPETOENT to run this command ")
(princ)

;------------ end of code ------

 

Change BYLAYER linetype setting to linetype defined for layer

 

 

https://knowledge.autodesk.com/support/autocad/troubleshooting/caas/sfdcarticles/sfdcarticles/Change...

 

This is the lisp I found on a website , it works fine , but only work on the entities you selected , doesn't work with entities inside blocks , is there a way to also change LTYPE inside a block?

Or in another word, make this command work in the whole drawing file like the SETBYLAYER command.

Sorry for my bad english , if you have trouble reading my question, I will try to explain more precisely.

 

 

0 Likes
Accepted solutions (1)
283 Views
2 Replies
Replies (2)
Message 2 of 3

ВeekeeCZ
Consultant
Consultant
Accepted solution

Try this code.

 

(vl-load-com)

(defun c:LTFromLayer (/ :fixblocknested adoc lst s i e d o l)
   
  (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-linetype (list o (cdr (assoc 6 (tblsearch "layer" (vla-get-layer o))))))))))
  
  ;; -------------------------------------------------------------------------------------------
  
  
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  
  (if (setq s (ssget "_:L"))

    (repeat (setq i (sslength s))

      (setq e (ssname s (setq i (1- i)))
	    d (entget e)
	    o (vlax-ename->vla-object e)
	    l (vla-get-layer o))
      
      (if (not (assoc 6 d))
	(vla-put-linetype o (cdr (assoc 6 (tblsearch "layer" l)))))

      (if (and (= "INSERT" (cdr (assoc 0 d)))
	       (setq n (cdr (assoc 2 d)))
	       )
	(:fixblocknested n))))

  (vla-endundomark adoc)
  (command "_.regenall")
  (princ)
  )

 

0 Likes
Message 3 of 3

tofumen0012
Participant
Participant
Thank you so much! It works nicely!
0 Likes