topic Re: A linetype lisp problem in Visual LISP, AutoLISP and General Customization Forum

A linetype lisp problem

tofumen0012 — Fri, 19 Aug 2022 11:39:49 GMT

;-------- 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-BYLAYER-linetype-setting-to-linetype-defined-for-layer.html

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.

Re: A linetype lisp problem

ВeekeeCZ — Fri, 19 Aug 2022 12:08:28 GMT

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)
  )

Re: A linetype lisp problem

tofumen0012 — Fri, 19 Aug 2022 18:32:24 GMT

Thank you so much! It works nicely!