封闭区域的文字对齐[源码]
本帖最后由 yxp 于 2013-6-5 17:53 编辑用了飞诗的 ssget 函数，仿一下院长的程序
按字符对齐时，可能会因文字高度不同而缩进距离不同。
;;**********************************************
;;带关键字的 ssget原创：飞诗，来自明经通道论坛
;;转载、引用请注明出处
;;**********************************************
(defun Fsxm-entsel (msg filter /enp)
(setq enp (entsel msg))
(if (or (= (type enp) 'str)
(and enp (ssget (cadr enp) filter))
)
enp
)
)
;;;用分隔符解释字符串成表
(defun Fsxm-Split (string strkey / po strlst xlen)
(setq xlen (1+ (strlen strkey)))
(while (setq po (vl-string-search strkey string))
(setq strlst (cons (substr string 1 po) strlst))
(setq string (substr string (+ po xlen)))
)
(reverse (cons string strlst))
)
;;点化字串
(defun Pt2Str (pt)
(strcat (rtos (car pt) 2 20)
","
(rtos (cadr pt) 2 20)
","
(rtos (caddr pt) 2 )
"\n")
)
(defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var)
(cond ((cadr (ssgetfirst)))
(t
(setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
(initget (strcat Kwd0 " " kwd))
(cond ((and (listp (setq var (fsxm-entsel Msg Fil)))
(/= 52 (getvar "errno"))
)
(vla-sendcommand *doc* (Pt2Str (cadr (grread t))))
(ssget ":S" Fil)
)
((member var (fsxm-split Kwd0 " "))
(vla-sendcommand *doc* (strcat var "\n"))
(ssget ":S" Fil)
)
(t var)
)
)
)
)
;;**********************************************
;;表格内文字水平对齐，条件: 文字外为线条封闭
;;明经通道 by yxpxa 2013-6-5
;;**********************************************
(defun c:bgtxt( / Ltn bgtxt-s bgtxt-a ss *acad* *doc* *error* *txtdq* *fpath* f)
(defun *error*(msg)(princ "\n程序结束")(princ))
(setq *acad* (vlax-get-acad-object)
*doc* (vla-get-ActiveDocument *acad*)
*fpath* (strcat (getvar "LOCALROOTPREFIX") "bgtext.dcl"))
(setq Ltn '(0 1 2 3 4 5 6 7 8 9 10);;dcl控件数
bgtxt-s (mapcar '(lambda(x) (strcat "bgtext" (itoa x))) Ltn)
bgtxt-a '(1 0 0 0 4.5 2 4.5 2 0 1 0));;默认值
(or *bgtxt-val* (setq *bgtxt-val* (mapcar 'cons bgtxt-s bgtxt-a))) ;;全局变量表：控件名及值
;;创建对话框
(if (null (findfile *fpath*))(progn
(setq f (open *fpath* "w"))
(mapcar '(lambda(x) (write-line x f)) (bgtxtssdcl))
(close f)
))
(show-mode *bgtxt-val*)
(while (setq ss (Fsxm-ssget "\n模式设置(D) / 或选择表格内文字 <退出>:" "D" '((0 . "TEXT"))))
(cond ((= ss "D") (bgtxt-getval))
((= (type ss) 'PICKSET)(bgtxt-treat ss))))
(princ)
)
;;文字修改主程序
(defun bgtxt-treat (ss / n a lhig lsys ptxt as ptz ptLt xxx wkent ptl xmax xmin Ldis Rdis)
(setq n 0 a *bgtxt-val*)
(setq Lhig (getvar "TEXTSIZE") Lsys (getvar "TEXTSTYLE"))
(command "undo" "be")
(if (> (sslength ss) 0)
(repeat (sslength ss)
(setq ptxt (entget (ssname ss n)))
(if (= (cdr (nth 10 a)) 1)
(setq as (vl-string-left-trim " " (cdr (assoc 1 ptxt)))
ptz (subst (cons 1 as)(assoc 1 ptxt) ptxt)
ptxt (entmod ptz)))
(if ptxt
(setq ptz (cdr (assoc 10 ptxt))
ptLt (txt-sbox ptxt)
xxx (car(car(textbox ptxt)))
wkent (bpoly (caddr ptLt))
n (1+ n))) ;;外框
(if (and ptxt wkent) (progn
(setq wkdxf (entget wkent)
ptL (vl-remove 'nil (mapcar '(lambda(x)(if (= (car x) 10)(cdr x))) wkdxf))
xmax (apply 'max (mapcar 'car ptL))
xmin (apply 'min (mapcar 'car ptL)))
(setq Ldis (if (= (cdr (nth 9 a)) 1) (* (cadr ptLt) (cdr (nth 5 a)))(cdr (nth 4 a)))
Rdis (if (= (cdr (nth 9 a)) 1) (* (cadr ptLt) (cdr (nth 7 a)))(cdr (nth 6 a))))
(cond
((= *txtdq* "左")(setq ptxt (bgtxt-modfy ptxt))
(entmod(subst (list 10 (- (+ xmin Ldis) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))
((= *txtdq* "右")(setq ptxt (bgtxt-modfy ptxt))
(entmod(subst (list 10 (- xmax Rdis (car ptLt) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))
((= *txtdq* "中")(setq ptxt (bgtxt-modfy ptxt))
(entmod(subst (list 10 (- (/ (- (+ xmin xmax) (car ptLt)) 2.) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))
((= *txtdq* "分散")(if (= (cdr (nth 8 a)) 1)(setq Ldis Rdis))
(entmod (setq ptxt (subst '(72 . 5)(assoc 72 ptxt) ptxt)
ptxt (subst (list 10 (- (+ xmin Ldis) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)
ptxt (subst (list 11 (- xmax Rdis)(cadr ptz) 0)(assoc 11 ptxt) ptxt)
ptxt (subst '(73 . 0)(assoc 73 ptxt) ptxt)))
)
)(entdel wkent)
))
)
(princ "\n未选择文本，程序结束")
)
(command "undo" "e")
(setvar "TEXTSIZE" Lhig)(setvar "TEXTSTYLE" Lsys)
(princ)
)
(defun bgtxt-modfy( dxf )
(setq dxf (subst '(72 . 0)(assoc 72 dxf) dxf)
dxf (subst '(73 . 0)(assoc 73 dxf) dxf)
dxf (subst '(41 . 0.76)(assoc 41 dxf) dxf);;修改宽度比例
)
)
;;返回单行文本的宽度、中心
(defun txt-sbox( Ldxf / Lsys Lhig p1 p2 p4th tw pp wsing)
(setq Lsys (cdr (assoc 7 Ldxf));;样式
Lhig (cdr (assoc 40 Ldxf)) ;;字高
p1 (cdr (assoc 10 Ldxf)) ;;文字dxf左下角
pp (textbox Ldxf) ;;文字伪对角线
tw (abs (- (car (cadr pp))(car (car pp)))) ;;文字的绝对宽度
th (- (cadr (cadr pp))(cadr (car pp)));;文字的绝对高度
p2 (list (+ (car p1) (car(car pp))) (+ (cadr p1)(cadr(car pp))));;左下
P4 (list (+ (car p2) (* 0.5 tw)) (+ (cadr p2) (* 0.5 th)))) ;;中
(setvar "TEXTSIZE" Lhig)(setvar "TEXTSTYLE" Lsys)
(setq pp (textbox '((1 . "字")))
Wsing (- (car (cadr pp))(car (car pp))));;单字宽度
(list tw wsing p4) ;;(+ (cadr p1)(cadr(car pp)))
)
;;模式显示
(defun show-mode(a)
(princ (strcat "\n模式: 对齐= "
(setq *txtdq* (car (vl-remove nil (mapcar '(lambda(x y)(if (= (cdr x) 1) y)) a '("左" "中" "右" "分散")))))
(if (= (cdr (nth 9 a)) 1)
(strcat "; 按字符缩进: 左侧= " (itoa (cdr (nth 5 a))) " 字符, 右侧= " (itoa (cdr (nth 7 a))) " 字符" )
(strcat "; 按距离缩进: 左侧= " (rtos (cdr (nth 4 a))) " 右侧= " (rtos (cdr (nth 6 a))))) "; 其他: "
(if (= (cdr (nth 8 a)) 1) "对称缩进" "无")
))
)
;;DCL主菜单控制
(defun bgtxt-getval( / Ltn dcl_id tems next)
;;DCL加载
(setq next 2 dcl_id (load_dialog *fpath*))
(while (>= next 2)
(if (not (new_dialog "bgtext" dcl_id))(exit))
;;下拉列表控件初始化
(foreach n '("bgtext5" "bgtext7")
(start_list n)
(mapcar '(lambda(x)(add_list (strcat (itoa x) " 字符"))) '(0 1 2 3 4))
(end_list)
)(setvar "DIMZIN" 9)
;;DCL控件操作预定义
(foreach n *bgtxt-val*
(set_tile (car n) (rtos (cdr n) 2 2)) ;;所有控件的赋值操作
(action_tile (car n) "(setq tems (dclvalue))") ;;取值操作
)
(bgthesame (get_tile "bgtext8"))
(action_tile "bgtext8" "(bgthesame $$$$value)")
(action_tile "bgbuton3" "(done_dialog 3)")
(action_tile "bgbuton2" "(done_dialog 2)")
(setq next (start_dialog))
(cond
((and (= next 1) tems) (show-mode (setq *bgtxt-val* tems)));;按确定键赋值有效
((= next 2)(putvalue 6 (getdist "\n请输入右侧间距 或 <点取>: "))(putvalue 9 0)(putvalue 8 0))
((= next 3)(putvalue 4 (getdist "\n请输入左侧间距 或 <点取>: "))(putvalue 9 0)))
)
(unload_dialog dcl_id)
(princ)
)
;;DCL取值函数
(defun dclvalue()
(mapcar '(lambda(x) (cons (car x) (read (get_tile (car x))))) *bgtxt-val*)
)
(defun putvalue(n i / s)
(setq s (car (nth n *bgtxt-val*))
*bgtxt-val* (subst (cons s i)(assoc s *bgtxt-val*) *bgtxt-val*))
)
(defun bgthesame(s)
(if (= s "1")(progn
(set_tile "bgtext6" (get_tile "bgtext4"))
(set_tile "bgtext7" (get_tile "bgtext5"))))
)
(defun bgtxtssdcl()
'("bgtext:dialog {label=\"表格内文字对齐\";spacer_1;"
":boxed_column{label=\"水平对齐\";"
":row{:radio_button{key=\"bgtext0\";label=\"左(&L)\";}"
" :radio_button{key=\"bgtext1\";label=\"中(&M)\";}"
" :radio_button{key=\"bgtext2\";label=\"右(&R)\";}"
" :radio_button{key=\"bgtext3\";label=\"分散(&F)\";}}}"
":boxed_column {label=\"缩进距离\";"
":row{:edit_box{key=\"bgtext4\";label=\"左侧(&A)\";}"
":button{label=\".<\";key=\"bgbuton3\";fixed_width=true;}"
":popup_list{key=\"bgtext5\";}}"
":row{:edit_box{key=\"bgtext6\";label=\"右侧(&B)\";}"
":button{label=\".<\";key=\"bgbuton2\";fixed_width=true;}"
":popup_list{key=\"bgtext7\";}}:spacer{height=0.1;}"
":row{:toggle{label=\"按字符宽度\";key=\"bgtext9\";}"
":toggle{label=\"对称缩进\";key=\"bgtext8\";}}}"
":row{:spacer{width=0.2;}:toggle{label=\"删除文字前空格\";"
" key=\"bgtext10\";}:spacer{width=20;}}"
" spacer_1;:row{spacer_1;"
":button{label=\"确定\";key=\"bgbuton1\";is_default=true;}"
":button{label=\"取消\";key=\"bgbuton0\";is_cancel=true;}"
" spacer_1;}spacer_1;}"))
(princ)
qq1254582201 发表于 2018-5-3 10:56
网上有网友那你的程序赚钱呢，赶紧投诉他http:// www.lisp123.com/wbl/2015/0129/440.html
果然是的，免费就罢了，竟然还收费，太不地道了。
没地方投诉啊，这网站就是他的 兄弟，你的这个程序非常好，又是源码，可惜不能竖向对齐，
能不能加上一个竖向中心对齐啊，感谢ing
网上有网友那你的程序赚钱呢，赶紧投诉他http:// www.lisp123.com/wbl/2015/0129/440.html 正事所需的，谢谢 好像用过后会改变文字的宽度 这个非常不错 程序改变了用户设置的字体的宽度因子。谢谢楼主分享。 来顶贴的，支持！ 好东西，应该上个演示的，增强一下大家的下载欲望。感谢了 测试过了，提出个建议，能否加个竖向对齐，不仅仅有水平对齐选项。 好东西，支持源码分享，感谢了 这个确实是好东东呀，赶快下载。