【源码】单行/多行文字等间距对齐，修改字高
本帖最后由 荒野孤行 于 2016-1-24 20:30 编辑此程序功能：将文字根据用户要求按左端、居中（垂直方向）、右、顶部、居中（水平方向）底部的方式对齐，同时可调整其间距！文字有倾角亦是可适用的！图片演示中以顶部排序的时候，文字顺序变反了，请自行修改源码。
说明：只提供大概的思路，请根据自己的需求自行修改。
;;; ***文字对齐 程序开始***
(defun c:wzdq ()
(princ
"\n功能：将文字根据用户要求按左端、居中（垂直方向）、右、顶部、居中（水平方向）底部的方式对齐，同时可调整其间距及字高！\n"
)
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(if (not (setq ss (ssget '((0 . "TEXT,MTEXT")))))
(progn (princ "\n未选中文字对象，程序退出。\n") (exit))
)
(command "undo" "be")
(initget "L R M T B C")
(if (not (setq kw
(getkword
"\n请选择对齐方式：[左端对齐(L)/以中心对齐（垂直方向）(M)/右端对齐(R)/顶部对齐(T)/以中心对齐（水平方向）(C)/底部对齐(B)/]<L>"
)
)
)
(setq kw "L")
)
(initget "Y N") ;让用户选择是否调整文字之间的间距
(if (not
(setq kwGap
(getkword "是否调整文字之间的间距？[是(Y)/否(N)]<Y>")
)
)
(setq kwGap "Y")
)
(if (= kwGap "Y")
(progn
(initget 6)
(if (not
(setq
gap (getdist "\n请指定排版后文字之间的间距：<3.0>")
)
)
(setq gap 3.0)
)
)
)
(setq i 0
lst '()
)
(setvar "osmode" 0)
(vl-load-com)
(repeat (sslength ss)
(setq txtentname (ssname ss i))
(cond
((= kw "L") ;左端对齐
(progn
(command "_.justifytext" txtentname "" "ML")
(wdy_wzdq_Ysort)
)
)
((= kw "M") ;以中心对齐（垂直方向）
(progn
(command "_.justifytext" txtentname "" "MC")
(wdy_wzdq_Ysort)
)
)
((= kw "R") ;右端对齐
(progn
(command "_.justifytext" txtentname "" "MR")
(wdy_wzdq_Ysort)
)
)
((= kw "T") ;顶部对齐
(progn
(command "_.justifytext" txtentname "" "TC")
(wdy_wzdq_Xsort)
)
)
((= kw "B") ;底部对齐
(progn
(command "_.justifytext" txtentname "" "BC")
(wdy_wzdq_Xsort)
)
)
((= kw "C") ;以中心对齐（水平方向）
(progn
(command "_.justifytext" txtentname "" "MC")
(wdy_wzdq_Xsort)
)
)
)
(setq i (1+ i))
)
;;;以重新排序后的表中的第一个文字对象作为参考对象
(setq entnam_base(car (car lst))
entdata_base (entget entnam_base)
enttype_base (cdr (assoc 0 entdata_base))
)
(if (= enttype_base "TEXT")
(setq tbox_base(textbox (list (car entdata_base)))
ptbl_base(car tbox_base)
pttr_base(cadr tbox_base)
pt_base (cdr (assoc 11 entdata_base))
;读取文字对象的插入点
ptx_base (car pt_base) ;插入点的X坐标
pty_base (cadr pt_base) ;插入点的Y坐标
ptx_pitchptx_base
pty_pitchpty_base
heigh_base (cdr (assoc 40 entdata_base))
width_base (abs (- (car pttr_base) (car ptbl_base)))
) ;若为单行文字
(setq pt_base (cdr (assoc 10 entdata_base))
;读取文字对象的插入点
ptx_base (car pt_base) ;插入点的X坐标
pty_base (cadr pt_base) ;插入点的Y坐标
ptx_pitchptx_base
pty_pitchpty_base
heigh_base (cdr (assoc 43 entdata_base))
;取多行文字的字体最大值
width_base (cdr (assoc 42 entdata_base))
) ;若为多行文字
)
(setq i 1)
(repeat (- (length lst) 1)
(setq entnam_current(car (nth i lst))
entdata_current (entget entnam_current)
enttype_current (cdr (assoc 0 entdata_current))
)
(if (or (= kw "L") (= kw "R") (= kw "M")) ;左中右对齐时
(progn (wdy_wzdq_type)
(if (= kwGap "Y")
(setq pty_pitch (+ pty_pitch
(* 0.5 heigh_base)
(* 0.5 heigh_current)
gap
)
heigh_base heigh_current
) ;若用户要求将文字间距设置为相同
(setq pty_pitch (cadr pt_current))
;若用户未要求将文字间距设置为相同，即为原始值时
)
(setq pt (list ptx_base pty_pitch 0))
(if (= enttype_current "TEXT")
(entmod (subst (cons 11 pt)
(assoc 11 entdata_current)
entdata_current
)
)
(entmod (subst (cons 10 pt)
(assoc 10 entdata_current)
entdata_current
)
)
)
)
)
(if (or (= kw "T") (= kw "B") (= kw "C")) ;顶中底
(progn (wdy_wzdq_type)
(if (= kwGap "Y")
(setq ptx_pitch (+ ptx_pitch
(* 0.5 width_base)
(* 0.5 width_current)
gap
)
width_base width_current
) ;若用户要求将文字间距设置为相同
(setq ptx_pitch (car pt_current))
;若用户未要求将文字间距设置为相同，即为原始值时
)
(setq pt (list ptx_pitch pty_base 0))
(if (= enttype_current "TEXT")
(entmod (subst (cons 11 pt)
(assoc 11 entdata_current)
entdata_current
)
)
(entmod (subst (cons 10 pt)
(assoc 10 entdata_current)
entdata_current
)
)
)
)
)
(setq i (1+ i))
)
(setvar "osmode" 15359)
(command "undo" "e")
(princ)
)
(defun wdy_wzdq_type ()
(if (= enttype_current "TEXT")
(setq tbox_current (textbox (list (car entdata_current)))
ptbl_current (car tbox_current)
pttr_current (cadr tbox_current)
pt_current (cdr (assoc 11 entdata_current))
;读取文字对象的插入点
heigh_current (cdr (assoc 40 entdata_current))
width_current (abs (- (car pttr_current) (car ptbl_current)))
) ;若为单行文字
(setq pt_current (cdr (assoc 10 entdata_current))
;读取文字对象的插入点
heigh_current (cdr (assoc 43 entdata_current))
width_current (cdr (assoc 42 entdata_current))
) ;若为多行文字
)
)
**** Hidden Message *****
;;; ***文字对齐 程序结束***
;若是要修改文字高度的请先按照如下程序调整好字高；上方程序中若以顶部/底部对齐时调整字高，算法太麻烦。
;;;***修改文字高度 程序开始***
(defun c:zg ()
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n★功能：批量修改文字高度.\n")
(setq a (ssget '((0 . "TEXT,MTEXT"))))
(setq ts (getdist "\n输入新的文字高度<2.5>:"))
(if (null ts)
(setq ts 2.5)
)
(setq n (sslength a))
(setq index 0)
(repeat n
(setq b1 (entget (ssname a index)))
(setq index (+ index 1))
(setq c (assoc 40 b1))
(setq d (cons (car c) ts))
(setq b2 (subst d c b1))
(entmod b2)
)
(command "undo" "e")
(princ)
)
;;;***修改文字高度 程序结束***
谢谢楼主分享，可是我的在使用时的提示文字怎么是这样的啊 感谢楼主，下载收藏 感谢楼主，收藏了 辛苦了~感谢整理分享~ 这程序真强大，感谢，收藏！ 收藏，单行/多行文字等间距对齐，修改字高 文字对齐试了下，好像不是这个WZDQ命令？ CAD2022中文字命令行乱码， 感谢了 很好用 刚需要，感谢 好厉害啊！收藏了 学习消化要很久可能