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

lxch

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

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

gmglass

常青藤中有此功能!!!!

awei21

我也想要,不过只想要单一的
其实,就是行距无法调整...伤脑筋
左对齐可以用对象特性功能.

urljit

试试这个行否？

lxch

对前人的程序进行了修改，可以自定义行距。
取名为dqwb（对齐文本）

2. 
   
3. (defun c:dqwb (/ A ALL B C L M N P VAL X0 XYZ_NEW Y Y0 Z)
   
4.   (setq a (ssget (list (cons 0 "text"))))
   
5.   (setq n (sslength a))
   
6.   (setq all nil)
   
7.   (setq m 0)
   
8.   (while (< m n)
   
9.     (setq all (append all (list (entget (ssname a m)))))
   
10.     (setq m (1+ m))
    
11.   )
    
12. 
    
13.   (setq l 0)
    
14.   (setq m 1)
    
15.   (while (< l n)
    
16.     (setq b (nth l all))
    
17.     (while (< m n)
    
18.       (setq c (nth m all))
    
19.       (if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))
    
20.         (progn
    
21.           (setq all (subst 'aa (nth l all) all))
    
22.           (setq all (subst 'bb (nth m all) all))
    
23.           (setq all (subst c 'aa all))
    
24.           (setq all (subst b 'bb all))
    
25.           (setq b c)
    
26.         )
    
27.       )
    
28.       (setq m (1+ m))
    
29.     )
    
30.     (setq l (1+ l))
    
31.     (setq m (1+ l))
    
32.   )
    
33. 
    
34.   (setq val (getreal "\n行距："))
    
35.   (setq p (getpoint "\n首行的插入点："))
    
36.   (setq x0 (car p))
    
37.   (setq y0 (cadr p))
    
38. 
    
39.   (setq m 0)
    
40.   (while (< m n)
    
41.     (setq b (nth m all))
    
42.     (setq y (- y0 (* m val)))
    
43.     (setq z (nth 3 (assoc '10 b)))
    
44.     (setq xyz_new (list '10 x0 y z))
    
45.     (setq b (subst (cons '72 0) (assoc '72 b) b))
    
46.     (setq b (subst (cons '73 0) (assoc '73 b) b))
    
47.     (setq b (subst xyz_new (assoc '10 b) b))
    
48.     (entmod b)
    
49.     (setq m (1+ m))
    
50.   )
    
51. )
    
52. (princ
    
53.   "\n＝＝＝对齐单行文本，自定义行距程序成功加载！命令行以dqwb启动！"
    
54. )

<br /> (defun c:dqwb (/ A ALL B C L M N P VAL X0 XYZ_NEW Y Y0 Z)<br />   (setq a (ssget (list (cons 0 "text"))))<br />   (setq n (sslength a))<br />   (setq all nil)<br />   (setq m 0)<br />   (while (< m n)<br />     (setq all (append all (list (entget (ssname a m)))))<br />     (setq m (1+ m))<br />   )<br /> <br />   (setq l 0)<br />   (setq m 1)<br />   (while (< l n)<br />     (setq b (nth l all))<br />     (while (< m n)<br />       (setq c (nth m all))<br />       (if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))<br />         (progn<br />           (setq all (subst 'aa (nth l all) all))<br />           (setq all (subst 'bb (nth m all) all))<br />           (setq all (subst c 'aa all))<br />           (setq all (subst b 'bb all))<br />           (setq b c)<br />         )<br />       )<br />       (setq m (1+ m))<br />     )<br />     (setq l (1+ l))<br />     (setq m (1+ l))<br />   )<br /> <br />   (setq val (getreal "\n行距："))<br />   (setq p (getpoint "\n首行的插入点："))<br />   (setq x0 (car p))<br />   (setq y0 (cadr p))<br /> <br />   (setq m 0)<br />   (while (< m n)<br />     (setq b (nth m all))<br />     (setq y (- y0 (* m val)))<br />     (setq z (nth 3 (assoc '10 b)))<br />     (setq xyz_new (list '10 x0 y z))<br />     (setq b (subst (cons '72 0) (assoc '72 b) b))<br />     (setq b (subst (cons '73 0) (assoc '73 b) b))<br />     (setq b (subst xyz_new (assoc '10 b) b))<br />     (entmod b)<br />     (setq m (1+ m))<br />   )<br /> )<br /> (princ<br />   "\n＝＝＝对齐单行文本，自定义行距程序成功加载！命令行以dqwb启动！"<br /> )

urljit

为了使程序具有人性化特点，建议修改如下：

(setq val (getdist "\n行距："))

这样，就可以使用键盘或者鼠标输入了。

lxch

谢谢指教。

ggb9034

晓东工具箱中有文本对齐和调行间距的功能，强烈建议使用晓东工具，

awei21

如果不嫌麻烦的话,我想告诉大家一个不需要外来工具即可实现的方法(前提是需要ET工具):
1.将所有文字炸成单行文字
2.按行序大概排好
3.转换成多行文字,并在需要的地方换行(行首不要留空格)
4.炸成单行文字
5.利用对象特性作其它的调整(单行文字对齐)
6.按需要改成多行文字或其它排列方式

haibinpro

挺好，正需要。