文本等间距对齐

xiaxiang

功能:把杂乱的文本按照输入的间距和对齐点进行整齐排列
命令：DQW
现有方式为左对齐，按y坐标降序排列。想要其他方式的自己YY.

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

;;;程序名 :dqw.LSP<br /> ;;;对齐单行文本，自定义行距程序 <br /> <br /> (defun c:dqw ()<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);按y坐标降序排列<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 (getdist "\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 "\n＝＝左对齐单行文本，自定义行距程序成功加载！命令行以dqw启动！")<br /> <br /> <br /> <br />

仲文玉

多行文本是不是要修改下程序才可以执行

Klein

冒泡法排序，有个更高效的方法，用vl-sort比较快

xtxkong

感谢楼主，刚好需要

mico_ye

有点用处，学习了

xiaxiang

回复 仲文玉 的帖子

不好意思，只有自己加上了，因为我用不着多行文本

cxs259

为什么加载后，出现语法错误提示

jialiang168

如果要改成x轴排序要改那一句？

xjf

          分享中，谢了

yoyoho

感谢分享,学习了!

dwjb

很好玩，很游戏一样，谢谢分享

jfxia

         能从中学到东西，谢了