对齐文本(lisp程序)
downloada
downloada Lv.2
2008年02月07日 16:01:45
只看楼主

本人一直在用的对齐文本的lisp,很好很不错dqwb的功能:在CAD画图时要输入好多的文字进行说明,可是由于不是起打的(好多个单行文字,参差不齐), 想让他们都对齐下面贴上源码;;;程序名 :dqwb.LSP;;;对齐单行文本,自定义行距程序 ;;;;;;编制者:lxch(from" 晓东家园",衷心感谢“lxch”);;;编制日期:2005.10.20(defun c:dqwb ()

本人一直在用的对齐文本的lisp,很好很不错

dqwb的功能:在CAD画图时要输入好多的文字进行说明,可是由于不是起打的(好多个单行文字,参差不齐),
想让他们都对齐

下面贴上源码



;;;程序名 :dqwb.LSP
;;;对齐单行文本,自定义行距程序
;;;
;;;编制者:lxch(from" 晓东家园",衷心感谢“lxch”)
;;;编制日期:2005.10.20

(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 (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===对齐单行文本,自定义行距程序成功加载!命令行以dqwb启动!")
免费打赏
jialiang168
2010年05月17日 13:41:15
12楼
:victory: :lol 謝謝樓主啊
回复
zhqs1983
2010年07月04日 15:28:39
13楼
自主研发值得期待
回复
wc861217
2010年08月28日 16:27:35
14楼
zhen 好 辛苦啦 谢谢
回复
lijiangxin
2010年08月28日 17:16:18
15楼
看不懂,帮你顶了
回复

相关推荐

APP内打开