对齐文本

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选项。

copy


;--------------------------------------------------------
;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)
)