[求助]：求多个单行文本的对齐程序

lxch

感觉我要找的程序应该有，但是没有找到。

我想要一个功能单一的，可以对图纸中的多个单行文本进行左对齐，并能够自定义行间距的lisp程序。

qjcpj

最初由 lxch 发布
[B]感觉我要找的程序应该有，但是没有找到。

我想要一个功能单一的，可以对图纸中的多个单行文本进行左对齐，并能够自定义行间距的lisp程序。 [/B]

从编程来讲不困难，改天写一个贴上来。

xbaron

你要是急用可以找ay工具集，里面有文本对齐工具可以自定义文本间距

但就是无法实现间距与左对齐一起实现，必须分两次！想改进一下，但是没有源码

本人又是白菜，自己编是没戏了！希望大虾们不吝赐教！

lxch

在别人程序的基础上改编了一个。

(defun c:dqwb ()
(setq a (ssget (list (cons 0 "text"))))
(setq n (sslength a))
(setq all nil)
(setq m 0)
(while (< m n)
(setq all (append all (list (entget (ssname a m)))))
(setq m (1+ m))
)

(setq l 0);;按y坐标降序排列
(setq m 1)
(while (< l n)
(setq b (nth l all))
(while (< m n)
(setq c (nth m all))
(if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))
(progn
(setq all (subst 'aa (nth l all) all ) )
(setq all (subst 'bb (nth m all) all ) )
(setq all (subst c 'aa all ) )
(setq all (subst b 'bb all ) )
(setq b c)
)
)
(setq m (1+ m))
)
(setq l (1+ l))
(setq m (1+ l))
)

(setq val (getreal "\n行距："))
(setq p (getpoint "\n首行的插入点："))
(setq x0 (car p))
(setq y0 (cadr p))

(setq m 0)
(while (< m n)
(setq b (nth m all))
(setq y (- y0 (* m val)))
(setq z (nth 3 (assoc '10 b)))
(setq xyz_new (list '10 x0 y z))
(setq b (subst (cons '72 0) (assoc '72 b) b))
(setq b (subst (cons '73 0) (assoc '73 b) b))
(setq b (subst xyz_new (assoc '10 b) b ) )
(entmod b)
(setq m (1+ m))
)
)
(princ "\n＝＝＝对齐单行文本，自定义行距程序成功加载！命令行以dqwb启动！")

songyun217

好！