得瑟的猫
发表于 2018-8-13 22:58:47
感谢楼主和楼上修改代码的大神!
依然小小鸟
发表于 2018-10-14 23:55:39
能帮忙修改为块或者任意实体齐线吗
lg328084985
发表于 2018-10-26 08:33:39
学习一下,。。
依然小小鸟
发表于 2018-10-26 08:53:05
尘缘一生 发表于 2018-7-22 06:36
我提的问题,还得我来修改?没有明白我得意思的?
下面发上代码:
能帮忙修改为块或者任意实体齐线吗
enn09
发表于 2018-10-26 09:02:22
很少用到曲线,学习了
479274135
发表于 2019-3-9 15:25:32
过来学习学习,谢谢分享
bai2000
发表于 2019-5-19 15:04:10
我也上传个文字复制并齐线的工具,出来不支持多段线、圆弧外都很完美、希望大神没改造一下支持多段线
(vl-load-com)
(defun c:wzqx (/ 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)
)
)
)
(setq ent (car (entsel "\n选择文字:")))
(if (= "TEXT" (cdr (assoc 0 (entget ent))))
(progn
(while (setq enl (entsel "\n选择对齐线:"))
(if (= "LINE" (cdr (assoc 0 (entget (car enl)))))
(progn
(setq pt1(cdr (assoc 10 (entget (car enl))))
pt2(cdr (assoc 11 (entget (car enl))))
mid_pt (vlax-curve-getClosestPointTo
(vlax-ename->vla-object (car enl))
(cadr enl)
)
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)) 100)
(cdr (assoc 1 (entget ent)))
ang
1
0
(cdr (assoc 40 (entget ent)))
(cdr (assoc 41 (entget ent)))
(cdr (assoc 7 (entget ent)))
)
)
)
)
)
)
(princ)
)
心中的梦想
发表于 2019-6-20 21:56:15
收藏了,谢谢分享!!!!!
luhy2008
发表于 2019-7-4 20:23:40
感谢楼主分享!
bluefcc1
发表于 2019-7-5 09:28:52
感谢楼主分享!