jonathann3891 发表于 2022-7-5 20:02:01

编辑多重引线文本

是否可以编辑此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)
)

abra-CAD-abra 发表于 2022-7-5 20:18:32

你好,jonathann3891,
 
请参阅李•麦克的第4篇文章。
 
干杯

jonathann3891 发表于 2022-7-5 20:33:07

非常感谢。

Lee Mac 发表于 2022-7-5 20:51:53

感谢推荐abra CAD abra!
 
我很高兴代码帮助了乔纳森。

jonathann3891 发表于 2022-7-5 21:03:04

代码唯一的问题是,它会缩小水平限制以修复文本,但会拉伸垂直限制。
页: [1]
查看完整版本: 编辑多重引线文本