SurveyCAD85 发表于 2022-7-5 15:57:36

对齐文本

你好
 
我们使用lisp将单行文本对齐到一行,方法是先选择行,然后选择文本。
 
它非常适合我们的需要,但是我们希望添加到Lisp中,以允许它选择多个文本项,而不仅仅是一个。
 
有人能帮忙吗
 
;--------------------------------------------------------
;lisp程序。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。aligntxt。lsp
;
;将文本对齐到一行
;
;---------------------------------------------------------
(定义c:at(/行ED SP EP A2 TEXT ED2)
 
(setq行(entsel“\n选择行:\ n”)
ED(entget(汽车线))
SP(cdr(assoc 10 ED))
EP(cdr(assoc 11 ED))
A2(角度SP EP)
文本(entsel“\n选择文本:\ n”)
ED2(entget(汽车文本))
AT(cdr(assoc 50 ED2))
ED2(变电站
(cons 50 A2)
(assoc 50 ED2)
ED2)
)
(entmod ED2)
 
(提示“\n\n”)
(普林斯)
)
 

BIGAL 发表于 2022-7-5 16:19:11

“你只需要一个文本ssget和一个重复,”添加了pline选项。
 

;--------------------------------------------------------
;lisp program...............................aligntxt.lsp
;
; aligns text to a line
;
;---------------------------------------------------------
; modified by Alan H to allow plines

(defun c:at (/ ent pt1 pt2 ang ss tobj

(setq ent (entsel "Select line or pline section"))
(setq objname (cdr (assoc 0 (entget (car ent)))))
(if (=objname"LWPOLYLINE")
(progn
(setq pr (vlax-curve-getparamatpoint (car ent) (setq p (vlax-curve-getclosestpointto (car ent) (cadr ent)))))
(setq pt1 (vlax-curve-getpointatparam (car ent) (fix pr)))
(setq pt2 (vlax-curve-getpointatparam (car ent) (1+ (fix pr))))
)
)
(if (=objname"LINE")
(progn
(setq pt1 (cdr (assoc 10 (entget (car ent)))))
(setq pt2 (cdr (assoc 11 (entget (car ent)))))
)
)
(setq ang (angle pt1 pt2))
(setq ss (ssget (list (cons 0 "*text"))))
(repeat (setq x (sslength ss))
(setq tobj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(vla-put-rotation tobj ang)
)

(prompt "\n \n")
(princ)
)

SurveyCAD85 发表于 2022-7-5 16:54:23

 
非常感谢。

SLW210 发表于 2022-7-5 16:59:50

请阅读代码发布指南,并编辑代码以包含在代码标签中。
Your Code Here=
Your Code Here
页: [1]
查看完整版本: 对齐文本