请求高手修改文字对齐工具，可应用于块中的线多段线和标注的线
本帖最后由 xj6019 于 2019-11-19 11:00 编辑本附件是论坛其他人的，我想文字对齐线的时候可以应用于对齐块中的线，多段线和标注的的线吗，请路过的高手，留下您的杰作，谢谢您可以在以下代码的基础上直接修改也行，等待着！！！！！！
代码如下
(defun c:wd (/ ent enl pt1 pt2 mid_pt ang)
(defun emk_t (layer pt1 pt2 text ang n72 n73 h w sty /)
(entmake (list '(0 . "text")
'(100 . "AcDbEntity")
(cons 8 layer)
'(100 . "AcDbText")
(cons 10 pt1)
(cons 1 text)
(cons 40 h)
(cons 41 w)
(cons 7 sty)
(cons 72 n72)
(cons 11 pt2)
(cons 50 ang)
(cons 73 n73)
)
)
)
(while
(setq ent (car (entsel "\n文字：")))
(if (= "TEXT" (cdr (assoc 0 (entget ent))))
(progn
(while (setq enl (car (entsel "\n線：")))
(if (= "LINE" (cdr (assoc 0 (entget enl))))
(progn
(setq pt1(cdr (assoc 10 (entget enl)))
pt2(cdr (assoc 11 (entget enl)))
mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt2 pt1)
ang(angle pt1 pt2)
)
(if (and (> ang (* 0.5 pi)) (<= ang (* pi 1.5)))
(setq ang (- ang pi))
)
(emk_t (cdr (assoc 8 (entget ent)))
'(0 0 0)
(polar mid_pt (+ ang (* 0.5 pi)) 20)
(cdr (assoc 1 (entget ent)))
ang
1
0
(cdr (assoc 40 (entget ent)))
(cdr (assoc 41 (entget ent)))
(cdr (assoc 7 (entget ent)))
)
)
)
)
)
))
(princ)
)
有人来帮帮忙吗来个高手呗
页:
[1]