编辑多重引线文本
是否可以编辑此lisp以处理mleader文本框?它将文本框隐藏到覆盖文本的最低要求。
(defun c:MTL (/ sset en el ymt nmt mtwidth mtcont)
(setq sset (ai_aselect))
(if (null sset)
(progn
(princ "\nNo objects selected.")
(exit)
)
)
(setq COUNT 0)
(setq ymt 0)
(setq nmt 0)
(if (/= sset nil)(setq EN (ssname sset COUNT))(setq EN nil))
(WHILE (/= EN nil)
(setq mtcont nil)
(setq nel nil)
(setq EL (entget EN))
(if (= (cdr (assoc 0 EL)) "MTEXT")
(progn
(setq mtwidth (* (cdr (assoc 42 el))1.015))
(setq EL (subst (cons 41 mtwidth) (assoc 41 EL) EL))
(progn
(setq nel el)
(while (/= (assoc 3 nel) nil)
(setq mtcont
(if (= mtcont nil)
(cdr (assoc 3 nel))
(strcat mtcont (cdr (assoc 3 nel)))
)
)
(setq nel (vl-remove (assoc 3 nel) nel))
)
(if (= mtcont nil)
(setq mtcont (cdr (assoc 1 nel)))
(setq mtcont (strcat mtcont (cdr (assoc 1 nel))))
)
(setq el nel)
)
(setq EL (subst (cons 1 mtcont) (assoc 1 EL) EL))
(if (= (cdr (assoc 90 EL)) 2)
(setq el (vl-remove (assoc 90 EL) EL))
)
(entmod EL)
(entupd en)
(setq el (entget en '("ACAD")))
(if (/= (assoc -3 el) nil)
(progn
(setq oheight (assoc 1040 (cdadr (assoc -3 el))))
(setq nheight (cons 1040 (cdr (assoc 43 el))))
(setq n-3 (list (cons -3 (list (subst nheight oheight (cadr (assoc -3 el)))))))
(setq el (vl-remove (assoc -3 el) el))
(setq el (append el n-3))
)
)
(entdel (cdr (assoc -1 el)))
(entmake el)
(setq COUNT (1+ COUNT))
(setq EN (SSNAME sset COUNT))
(setq ymt (1+ ymt))
)
(progn
(setq COUNT (1+ COUNT))
(setq EN (SSNAME sset COUNT))
(setq nmt (1+ nmt))
)
)
)
(prompt (strcat "\n" (itoa ymt) " Mtext object(s) were resized, and " (itoa nmt) " object(s) were not Mtext."))
(princ)
)
你好,jonathann3891,
请参阅李•麦克的第4篇文章。
干杯 非常感谢。 感谢推荐abra CAD abra!
我很高兴代码帮助了乔纳森。 代码唯一的问题是,它会缩小水平限制以修复文本,但会拉伸垂直限制。
页:
[1]