- UID
- 783614
- 积分
- 1089
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2019-1-15
- 最后登录
- 1970-1-1
|
发表于 2020-3-21 17:38:48
|
显示全部楼层
参考了PXR201419的程序, 不修改文字的对齐方式
(defun c:tt( / ss i stxt ent lin pend pmid qd ang osm txt entpar pt pt1)
(defun field(fent / pmin pmax)
(vla-getboundingbox (vlax-ename->vla-object fent) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))
(list (list (car pmin) (cadr pmin)) (list (car pmax) (cadr pmax)))
)
(vl-load-com)
(prompt "\n选择1根线和1-2个文字:")
(while (and (setq ss (ssget (list (cons 0 "TEXT,*LINE,ARC"))))
(<= 2 (sslength ss) 3)
)
(setq i -1 stxt (ssadd))
(while (setq ent (ssname ss (setq i (1+ i))))
(if (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC")
(setq lin ent pend (vlax-curve-getendpoint lin)
pmid (vlax-curve-getpointatdist lin (/ (vlax-curve-getdistatpoint lin pend) 2))
qd (vlax-curve-getfirstderiv lin (vlax-curve-getParamAtPoint lin pmid)) )
(ssadd ent stxt)
)
)
(if (and lin pmid qd stxt)
(progn (setq ang (cond ((< (car qd) 0) (angle qd (list 0 0)))
((> (car qd) 0) (angle (list 0 0) qd))
(t (/ pi 2))))
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(command "rotate" stxt "" "none" (trans pmid 0 1) (* -180 (/ ang pi)))
(setq i -1)
(while (setq txt (ssname stxt (setq i (1+ i))))
(setq entpar (entget txt))
(setq pt (field txt))
(setq pt (/ (+ (cadr (car pt)) (cadr (cadr pt))) 2))
(entmod (subst (cons 50 0) (assoc 50 entpar) entpar))
(setq pt1 (field txt))
(if (> pt (cadr pmid))
(command "move" txt ""
(list (/ (+ (car (car pt1)) (car (cadr pt1))) 2) (cadr (car pt1)))
(list (car pmid) (+ (cadr pmid) (/ (cdr (assoc 40 entpar)) 2)))
)
(command "move" txt ""
(list (/ (+ (car (car pt1)) (car (cadr pt1))) 2) (cadr (cadr pt1)))
(list (car pmid) (- (cadr pmid) (/ (cdr (assoc 40 entpar)) 2)))
)
)
)
(command "rotate" stxt "" (trans pmid 0 1) (* 180 (/ ang pi)))
(setvar "osmode" osm)
)
)
(prompt "\n选择1根线和1-2个文字:")
)
(princ)
)
|
|