xiaxiang 发表于 2011-3-1 22:52:22

文本等间距对齐

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

(defun c:dqw ()
(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 (getdist "\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＝＝左对齐单行文本，自定义行距程序成功加载！命令行以dqw启动！")







仲文玉 发表于 2011-3-2 09:52:38

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

Klein 发表于 2023-1-13 14:39:25

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

xtxkong 发表于 2018-2-28 09:20:15

感谢楼主，刚好需要

mico_ye 发表于 2011-3-2 09:35:53

有点用处，学习了

xiaxiang 发表于 2011-3-2 10:33:04

回复 仲文玉 的帖子

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

cxs259 发表于 2011-3-2 10:51:03

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

jialiang168 发表于 2011-3-3 23:29:54

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

xjf 发表于 2011-4-20 12:33:28

          分享中，谢了

yoyoho 发表于 2011-4-20 20:31:27

感谢分享,学习了!

dwjb 发表于 2011-4-20 21:23:30

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

jfxia 发表于 2011-4-21 12:38:23

         能从中学到东西，谢了
页: [1] 2 3 4 5
查看完整版本: 文本等间距对齐