封闭区域的文字对齐[源码]

yxp

用了飞诗的 ssget 函数，仿一下院长的程序

按字符对齐时，可能会因文字高度不同而缩进距离不同。

2. 
   
3. 
   
4. ;;**********************************************
   
5. ;;带关键字的 ssget  原创：飞诗，来自明经通道论坛
   
6. ;;转载、引用请注明出处
   
7. ;;**********************************************
   
8. 
   
9. (defun Fsxm-entsel (msg filter /  enp)
   
10.   (setq enp (entsel msg))
    
11.   (if (or (= (type enp) 'str)
    
12.           (and enp (ssget (cadr enp) filter))
    
13.       )
    
14.     enp
    
15.   )
    
16. )
    
17. 
    
18. ;;;用分隔符解释字符串成表
    
19. (defun Fsxm-Split (string strkey / po strlst xlen)
    
20.   (setq xlen (1+ (strlen strkey)))
    
21.   (while (setq po (vl-string-search strkey string))
    
22.     (setq strlst (cons (substr string 1 po) strlst))
    
23.     (setq string (substr string (+ po xlen)))
    
24.   )
    
25.   (reverse (cons string strlst))
    
26. )
    
27. 
    
28. ;;点化字串
    
29. (defun Pt2Str (pt)
    
30.   (strcat (rtos (car pt) 2 20)
    
31.          ","
    
32.           (rtos (cadr pt) 2 20)
    
33.           ","
    
34.           (rtos (caddr pt) 2 )
    
35.           "\n")
    
36. )
    
37. 
    
38. (defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var)
    
39.   (cond ((cadr (ssgetfirst)))
    
40.         (t
    
41.          (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")
    
42.          (initget (strcat Kwd0 " " kwd))
    
43.          (cond ((and (listp (setq var (fsxm-entsel Msg Fil)))
    
44.                      (/= 52 (getvar "errno"))
    
45.                 )
    
46.                 (vla-sendcommand *doc* (Pt2Str (cadr (grread t))))
    
47.                 (ssget ":S" Fil)
    
48.                )
    
49.                ((member var (fsxm-split Kwd0 " "))
    
50.                 (vla-sendcommand *doc* (strcat var "\n"))
    
51.                 (ssget ":S" Fil)
    
52.                )
    
53.                (t var)
    
54.          )
    
55.         )
    
56.   )
    
57. )
    
58. 
    
59. 
    
60. ;;**********************************************
    
61. ;;表格内文字水平对齐，条件: 文字外为线条封闭
    
62. ;;明经通道   by yxpxa    2013-6-5
    
63. ;;**********************************************
    
64. 
    
65. (defun c:bgtxt( / Ltn bgtxt-s bgtxt-a ss *acad* *doc* *error* *txtdq* *fpath* f)
    
66.   (defun *error*(msg)(princ "\n程序结束")(princ))
    
67.   (setq *acad* (vlax-get-acad-object)
    
68.         *doc* (vla-get-ActiveDocument *acad*)
    
69.         *fpath* (strcat (getvar "LOCALROOTPREFIX") "bgtext.dcl"))
    
70.         
    
71.   (setq Ltn '(0 1 2 3 4 5 6 7 8 9 10)  ;;dcl控件数
    
72.         bgtxt-s (mapcar '(lambda(x) (strcat "bgtext" (itoa x))) Ltn)
    
73.         bgtxt-a '(1 0 0 0 4.5 2 4.5 2 0 1 0))  ;;默认值
    
74.   (or *bgtxt-val* (setq *bgtxt-val* (mapcar 'cons bgtxt-s bgtxt-a))) ;;全局变量表：控件名及值
    
75.   ;;创建对话框
    
76.   (if (null (findfile *fpath*))(progn
    
77.    (setq f (open *fpath* "w"))
    
78.        (mapcar '(lambda(x) (write-line x f)) (bgtxtssdcl))
    
79.    (close f)
    
80.   ))
    
81.   (show-mode *bgtxt-val*)
    
82. (while (setq ss (Fsxm-ssget "\n模式设置(D) / 或选择表格内文字 <退出>:" "D" '((0 . "TEXT"))))
    
83.         (cond ((= ss "D") (bgtxt-getval))
    
84.               ((= (type ss) 'PICKSET)(bgtxt-treat ss))))
    
85. (princ)
    
86. )
    
87. 
    
88. ;;文字修改主程序
    
89. (defun bgtxt-treat (ss / n a lhig lsys ptxt as ptz ptLt xxx wkent ptl xmax xmin Ldis Rdis)
    
90. (setq n 0 a *bgtxt-val*)
    
91. (setq Lhig (getvar "TEXTSIZE") Lsys (getvar "TEXTSTYLE"))
    
92. (command "undo" "be")
    
93. (if (> (sslength ss) 0)
    
94.   (repeat (sslength ss)
    
95.      (setq ptxt (entget (ssname ss n)))
    
96.      (if (= (cdr (nth 10 a)) 1)
    
97.        (setq as (vl-string-left-trim " " (cdr (assoc 1 ptxt)))
    
98.              ptz (subst (cons 1 as)(assoc 1 ptxt) ptxt)
    
99.              ptxt (entmod ptz)))
    
100.      (if ptxt        
     
101.      (setq ptz (cdr (assoc 10 ptxt))
     
102.            ptLt (txt-sbox ptxt)
     
103.            xxx (car(car(textbox ptxt)))
     
104.           wkent (bpoly (caddr ptLt))
     
105.               n (1+ n))) ;;外框
     
106.      (if (and ptxt wkent) (progn
     
107.      (setq wkdxf (entget wkent)
     
108.             ptL (vl-remove 'nil (mapcar '(lambda(x)(if (= (car x) 10)(cdr x))) wkdxf))
     
109.             xmax (apply 'max (mapcar 'car ptL))
     
110.             xmin (apply 'min (mapcar 'car ptL)))
     
111.       (setq Ldis (if (= (cdr (nth 9 a)) 1) (* (cadr ptLt) (cdr (nth 5 a)))(cdr (nth 4 a)))
     
112.             Rdis (if (= (cdr (nth 9 a)) 1) (* (cadr ptLt) (cdr (nth 7 a)))(cdr (nth 6 a))))
     
113.       (cond
     
114.           ((= *txtdq* "左")(setq ptxt (bgtxt-modfy ptxt))
     
115.                 (entmod(subst (list 10 (- (+ xmin Ldis) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))
     
116.           ((= *txtdq* "右")(setq ptxt (bgtxt-modfy ptxt))
     
117.                (entmod(subst (list 10 (- xmax Rdis (car ptLt) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))
     
118.           ((= *txtdq* "中")(setq ptxt (bgtxt-modfy ptxt))
     
119.               (entmod(subst (list 10 (- (/ (- (+ xmin xmax) (car ptLt)) 2.) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))
     
120.           ((= *txtdq* "分散")(if (= (cdr (nth 8 a)) 1)(setq Ldis Rdis))
     
121.              (entmod (setq ptxt (subst '(72 . 5)(assoc 72 ptxt) ptxt)
     
122.                     ptxt (subst (list 10 (- (+ xmin Ldis) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)
     
123.                     ptxt (subst (list 11 (- xmax Rdis)(cadr ptz) 0)(assoc 11 ptxt) ptxt)
     
124.                     ptxt (subst '(73 . 0)(assoc 73 ptxt) ptxt)))
     
125.             )
     
126.       )(entdel wkent)
     
127.      ))
     
128.   )
     
129.   (princ "\n未选择文本，程序结束")
     
130.   )
     
131. (command "undo" "e")
     
132. (setvar "TEXTSIZE" Lhig)(setvar "TEXTSTYLE" Lsys)
     
133. (princ)
     
134. )
     
135. 
     
136. (defun bgtxt-modfy( dxf )
     
137. (setq dxf (subst '(72 . 0)(assoc 72 dxf) dxf)
     
138.       dxf (subst '(73 . 0)(assoc 73 dxf) dxf)
     
139.       dxf (subst '(41 . 0.76)(assoc 41 dxf) dxf)  ;;修改宽度比例
     
140. )
     
141. )
     
142. 
     
143. ;;返回单行文本的宽度、中心
     
144. (defun txt-sbox( Ldxf / Lsys Lhig p1 p2 p4th tw pp wsing)
     
145. (setq Lsys (cdr (assoc 7 Ldxf))  ;;样式
     
146.        Lhig (cdr (assoc 40 Ldxf)) ;;字高
     
147.         p1 (cdr (assoc 10 Ldxf))    ;;文字dxf左下角
     
148.         pp (textbox Ldxf)           ;;文字伪对角线
     
149.         tw (abs (- (car (cadr pp))(car (car pp))))    ;;文字的绝对宽度
     
150.         th (- (cadr (cadr pp))(cadr (car pp)))  ;;文字的绝对高度
     
151.         p2 (list (+ (car p1) (car(car pp))) (+ (cadr p1)(cadr(car pp))))  ;;左下
     
152.         P4 (list (+ (car p2) (* 0.5 tw)) (+ (cadr p2) (* 0.5 th))))       ;;中
     
153.   (setvar "TEXTSIZE" Lhig)(setvar "TEXTSTYLE" Lsys)
     
154.   (setq pp (textbox '((1 . "字")))
     
155.         Wsing (- (car (cadr pp))(car (car pp))));;单字宽度
     
156.   (list tw wsing p4) ;;(+ (cadr p1)(cadr(car pp)))
     
157. )
     
158. 
     
159. ;;模式显示
     
160. (defun show-mode(a)
     
161. (princ (strcat "\n模式: 对齐= "
     
162.   (setq *txtdq* (car (vl-remove nil (mapcar '(lambda(x y)(if (= (cdr x) 1) y)) a '("左" "中" "右" "分散")))))
     
163.   (if (= (cdr (nth 9 a)) 1)
     
164.   (strcat "; 按字符缩进: 左侧= " (itoa (cdr (nth 5 a))) " 字符, 右侧= " (itoa (cdr (nth 7 a))) " 字符" )
     
165.   (strcat "; 按距离缩进: 左侧= " (rtos (cdr (nth 4 a))) " 右侧= " (rtos (cdr (nth 6 a))))) "; 其他: "
     
166.   (if (= (cdr (nth 8 a)) 1) "对称缩进" "无")
     
167. ))
     
168. )
     
169. 
     
170. ;;DCL主菜单控制
     
171. (defun bgtxt-getval( / Ltn dcl_id tems next)
     
172. ;;DCL加载
     
173. (setq next 2 dcl_id (load_dialog *fpath*))
     
174. (while (>= next 2)
     
175.   (if (not (new_dialog "bgtext" dcl_id))(exit))
     
176. 
     
177. ;;下拉列表控件初始化
     
178.   (foreach n '("bgtext5" "bgtext7")
     
179.     (start_list n)
     
180.     (mapcar '(lambda(x)(add_list (strcat (itoa x) " 字符"))) '(0 1 2 3 4))
     
181.     (end_list)
     
182.   )(setvar "DIMZIN" 9)
     
183. ;;DCL控件操作预定义
     
184.   (foreach n *bgtxt-val*
     
185.      (set_tile (car n) (rtos (cdr n) 2 2)) ;;所有控件的赋值操作
     
186.       (action_tile (car n) "(setq tems (dclvalue))") ;;取值操作
     
187.    )
     
188.   (bgthesame (get_tile "bgtext8"))
     
189.   (action_tile "bgtext8" "(bgthesame $$$$value)")
     
190.   (action_tile "bgbuton3" "(done_dialog 3)")
     
191.   (action_tile "bgbuton2" "(done_dialog 2)")
     
192.   (setq next (start_dialog))
     
193.   (cond
     
194.     ((and (= next 1) tems) (show-mode (setq *bgtxt-val* tems)));;按确定键赋值有效
     
195.     ((= next 2)(putvalue 6 (getdist "\n请输入右侧间距 或 <点取>: "))(putvalue 9 0)(putvalue 8 0))
     
196.     ((= next 3)(putvalue 4 (getdist "\n请输入左侧间距 或 <点取>: "))(putvalue 9 0)))
     
197. )
     
198.   (unload_dialog dcl_id)
     
199. (princ)
     
200. )
     
201. 
     
202. ;;DCL取值函数
     
203. (defun dclvalue()
     
204. (mapcar '(lambda(x) (cons (car x) (read (get_tile (car x))))) *bgtxt-val*)
     
205. )
     
206. (defun putvalue(n i / s)
     
207. (setq s (car (nth n *bgtxt-val*))
     
208.     *bgtxt-val* (subst (cons s i)(assoc s *bgtxt-val*) *bgtxt-val*))
     
209. )
     
210. (defun bgthesame(s)
     
211. (if (= s "1")(progn
     
212. (set_tile "bgtext6" (get_tile "bgtext4"))
     
213. (set_tile "bgtext7" (get_tile "bgtext5"))))
     
214. )
     
215. 
     
216. (defun bgtxtssdcl()
     
217. '("bgtext:dialog {label="表格内文字对齐";spacer_1;"
     
218. ":boxed_column{label="水平对齐";"
     
219. ":row{:radio_button{key="bgtext0";label="左(&L)";}"
     
220. "    :radio_button{key="bgtext1";label="中(&M)";}"
     
221. "    :radio_button{key="bgtext2";label="右(&R)";}"
     
222. "    :radio_button{key="bgtext3";label="分散(&F)";}}}"
     
223. ":boxed_column {label="缩进距离";"
     
224. ":row{:edit_box{key="bgtext4";label="左侧(&A)";}"
     
225. ":button{label=".<";key="bgbuton3";fixed_width=true;}"
     
226. ":popup_list{key="bgtext5";}}"
     
227. ":row{:edit_box{key="bgtext6";label="右侧(&B)";}"
     
228. ":button{label=".<";key="bgbuton2";fixed_width=true;}"
     
229. ":popup_list{key="bgtext7";}}:spacer{height=0.1;}"
     
230. ":row{:toggle{label="按字符宽度";key="bgtext9";}"
     
231. ":toggle{label="对称缩进";key="bgtext8";}}}"
     
232. ":row{:spacer{width=0.2;}:toggle{label="删除文字前空格";"
     
233. " key="bgtext10";}:spacer{width=20;}}"
     
234. " spacer_1;:row{spacer_1;"
     
235. ":button{label="确定";key="bgbuton1";is_default=true;}"
     
236. ":button{label="取消";key="bgbuton0";is_cancel=true;}"
     
237. " spacer_1;}spacer_1;}"))
     
238. 
     
239. (princ)
     

<br /> <br /> ;;**********************************************<br /> ;;带关键字的 ssget  原创：飞诗，来自明经通道论坛<br /> ;;转载、引用请注明出处<br /> ;;**********************************************<br /> <br /> (defun Fsxm-entsel (msg filter /  enp)<br />   (setq enp (entsel msg))<br />   (if (or (= (type enp) 'str)<br />           (and enp (ssget (cadr enp) filter))<br />       )<br />     enp<br />   )<br /> )<br /> <br /> ;;;用分隔符解释字符串成表<br /> (defun Fsxm-Split (string strkey / po strlst xlen)<br />   (setq xlen (1+ (strlen strkey)))<br />   (while (setq po (vl-string-search strkey string))<br />     (setq strlst (cons (substr string 1 po) strlst))<br />     (setq string (substr string (+ po xlen)))<br />   )<br />   (reverse (cons string strlst))<br /> )<br /> <br /> ;;点化字串<br /> (defun Pt2Str (pt)<br />   (strcat (rtos (car pt) 2 20)<br />          ","<br />           (rtos (cadr pt) 2 20)<br />           ","<br />           (rtos (caddr pt) 2 )<br />           "\n")<br /> )<br /> <br /> (defun Fsxm-ssget (Msg Kwd Fil / Kwd0 pt var)<br />   (cond ((cadr (ssgetfirst)))<br />         (t<br />          (setq Kwd0 "W L C BOX ALL F WP CP G A R M P U AU SI")<br />          (initget (strcat Kwd0 " " kwd))<br />          (cond ((and (listp (setq var (fsxm-entsel Msg Fil)))<br />                      (/= 52 (getvar "errno"))<br />                 )<br />                 (vla-sendcommand *doc* (Pt2Str (cadr (grread t))))<br />                 (ssget ":S" Fil)<br />                )<br />                ((member var (fsxm-split Kwd0 " "))<br />                 (vla-sendcommand *doc* (strcat var "\n"))<br />                 (ssget ":S" Fil)<br />                )<br />                (t var)<br />          )<br />         )<br />   )<br /> )<br /> <br /> <br /> ;;**********************************************<br /> ;;表格内文字水平对齐，条件: 文字外为线条封闭<br /> ;;明经通道   by yxpxa    2013-6-5<br /> ;;**********************************************<br /> <br /> (defun c:bgtxt( / Ltn bgtxt-s bgtxt-a ss *acad* *doc* *error* *txtdq* *fpath* f)<br />   (defun *error*(msg)(princ "\n程序结束")(princ))<br />   (setq *acad* (vlax-get-acad-object)<br />         *doc* (vla-get-ActiveDocument *acad*)<br />         *fpath* (strcat (getvar "LOCALROOTPREFIX") "bgtext.dcl"))<br />         <br />   (setq Ltn '(0 1 2 3 4 5 6 7 8 9 10)  ;;dcl控件数<br />         bgtxt-s (mapcar '(lambda(x) (strcat "bgtext" (itoa x))) Ltn)<br />         bgtxt-a '(1 0 0 0 4.5 2 4.5 2 0 1 0))  ;;默认值<br />   (or *bgtxt-val* (setq *bgtxt-val* (mapcar 'cons bgtxt-s bgtxt-a))) ;;全局变量表：控件名及值<br />   ;;创建对话框<br />   (if (null (findfile *fpath*))(progn<br />    (setq f (open *fpath* "w"))<br />        (mapcar '(lambda(x) (write-line x f)) (bgtxtssdcl))<br />    (close f)<br />   ))<br />   (show-mode *bgtxt-val*)<br /> (while (setq ss (Fsxm-ssget "\n模式设置(D) / 或选择表格内文字 <退出>:" "D" '((0 . "TEXT"))))<br />         (cond ((= ss "D") (bgtxt-getval))<br />               ((= (type ss) 'PICKSET)(bgtxt-treat ss))))<br /> (princ) <br /> )<br /> <br /> ;;文字修改主程序<br /> (defun bgtxt-treat (ss / n a lhig lsys ptxt as ptz ptLt xxx wkent ptl xmax xmin Ldis Rdis)<br /> (setq n 0 a *bgtxt-val*)<br /> (setq Lhig (getvar "TEXTSIZE") Lsys (getvar "TEXTSTYLE"))<br /> (command "undo" "be")<br /> (if (> (sslength ss) 0)<br />   (repeat (sslength ss)<br />      (setq ptxt (entget (ssname ss n)))<br />      (if (= (cdr (nth 10 a)) 1)<br />        (setq as (vl-string-left-trim " " (cdr (assoc 1 ptxt)))<br />              ptz (subst (cons 1 as)(assoc 1 ptxt) ptxt)<br />              ptxt (entmod ptz)))<br />      (if ptxt        <br />      (setq ptz (cdr (assoc 10 ptxt))<br />            ptLt (txt-sbox ptxt)<br />            xxx (car(car(textbox ptxt)))<br />           wkent (bpoly (caddr ptLt))<br />               n (1+ n))) ;;外框<br />      (if (and ptxt wkent) (progn<br />      (setq wkdxf (entget wkent)<br />             ptL (vl-remove 'nil (mapcar '(lambda(x)(if (= (car x) 10)(cdr x))) wkdxf))<br />             xmax (apply 'max (mapcar 'car ptL))<br />             xmin (apply 'min (mapcar 'car ptL)))<br />       (setq Ldis (if (= (cdr (nth 9 a)) 1) (* (cadr ptLt) (cdr (nth 5 a)))(cdr (nth 4 a)))<br />             Rdis (if (= (cdr (nth 9 a)) 1) (* (cadr ptLt) (cdr (nth 7 a)))(cdr (nth 6 a))))<br />       (cond <br />           ((= *txtdq* "左")(setq ptxt (bgtxt-modfy ptxt))<br />                 (entmod(subst (list 10 (- (+ xmin Ldis) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))<br />           ((= *txtdq* "右")(setq ptxt (bgtxt-modfy ptxt))<br />                (entmod(subst (list 10 (- xmax Rdis (car ptLt) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))<br />           ((= *txtdq* "中")(setq ptxt (bgtxt-modfy ptxt))<br />               (entmod(subst (list 10 (- (/ (- (+ xmin xmax) (car ptLt)) 2.) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)))<br />           ((= *txtdq* "分散")(if (= (cdr (nth 8 a)) 1)(setq Ldis Rdis))<br />              (entmod (setq ptxt (subst '(72 . 5)(assoc 72 ptxt) ptxt)<br />                     ptxt (subst (list 10 (- (+ xmin Ldis) xxx) (cadr ptz)) (assoc 10 ptxt) ptxt)<br />                     ptxt (subst (list 11 (- xmax Rdis)(cadr ptz) 0)(assoc 11 ptxt) ptxt)<br />                     ptxt (subst '(73 . 0)(assoc 73 ptxt) ptxt)))<br />             )<br />       )(entdel wkent)<br />      ))<br />   )<br />   (princ "\n未选择文本，程序结束")<br />   )<br /> (command "undo" "e")<br /> (setvar "TEXTSIZE" Lhig)(setvar "TEXTSTYLE" Lsys)<br /> (princ)<br /> )<br /> <br /> (defun bgtxt-modfy( dxf )<br /> (setq dxf (subst '(72 . 0)(assoc 72 dxf) dxf)<br />       dxf (subst '(73 . 0)(assoc 73 dxf) dxf)<br />       dxf (subst '(41 . 0.76)(assoc 41 dxf) dxf)  ;;修改宽度比例<br /> )<br /> )<br /> <br /> ;;返回单行文本的宽度、中心 <br /> (defun txt-sbox( Ldxf / Lsys Lhig p1 p2 p4th tw pp wsing)<br /> (setq Lsys (cdr (assoc 7 Ldxf))  ;;样式<br />        Lhig (cdr (assoc 40 Ldxf)) ;;字高<br />         p1 (cdr (assoc 10 Ldxf))    ;;文字dxf左下角<br />         pp (textbox Ldxf)           ;;文字伪对角线<br />         tw (abs (- (car (cadr pp))(car (car pp))))    ;;文字的绝对宽度<br />         th (- (cadr (cadr pp))(cadr (car pp)))  ;;文字的绝对高度<br />         p2 (list (+ (car p1) (car(car pp))) (+ (cadr p1)(cadr(car pp))))  ;;左下<br />         P4 (list (+ (car p2) (* 0.5 tw)) (+ (cadr p2) (* 0.5 th))))       ;;中<br />   (setvar "TEXTSIZE" Lhig)(setvar "TEXTSTYLE" Lsys)<br />   (setq pp (textbox '((1 . "字")))<br />         Wsing (- (car (cadr pp))(car (car pp))));;单字宽度<br />   (list tw wsing p4) ;;(+ (cadr p1)(cadr(car pp)))<br /> )<br /> <br /> ;;模式显示<br /> (defun show-mode(a)<br /> (princ (strcat "\n模式: 对齐= " <br />   (setq *txtdq* (car (vl-remove nil (mapcar '(lambda(x y)(if (= (cdr x) 1) y)) a '("左" "中" "右" "分散")))))<br />   (if (= (cdr (nth 9 a)) 1)<br />   (strcat "; 按字符缩进: 左侧= " (itoa (cdr (nth 5 a))) " 字符, 右侧= " (itoa (cdr (nth 7 a))) " 字符" )<br />   (strcat "; 按距离缩进: 左侧= " (rtos (cdr (nth 4 a))) " 右侧= " (rtos (cdr (nth 6 a))))) "; 其他: "<br />   (if (= (cdr (nth 8 a)) 1) "对称缩进" "无") <br /> ))<br /> )<br /> <br /> ;;DCL主菜单控制<br /> (defun bgtxt-getval( / Ltn dcl_id tems next)<br /> ;;DCL加载<br /> (setq next 2 dcl_id (load_dialog *fpath*))<br /> (while (>= next 2) <br />   (if (not (new_dialog "bgtext" dcl_id))(exit))<br /> <br /> ;;下拉列表控件初始化<br />   (foreach n '("bgtext5" "bgtext7")<br />     (start_list n)<br />     (mapcar '(lambda(x)(add_list (strcat (itoa x) " 字符"))) '(0 1 2 3 4))<br />     (end_list)<br />   )(setvar "DIMZIN" 9)<br /> ;;DCL控件操作预定义<br />   (foreach n *bgtxt-val*<br />      (set_tile (car n) (rtos (cdr n) 2 2)) ;;所有控件的赋值操作<br />       (action_tile (car n) "(setq tems (dclvalue))") ;;取值操作<br />    )<br />   (bgthesame (get_tile "bgtext8"))<br />   (action_tile "bgtext8" "(bgthesame $$$$value)")<br />   (action_tile "bgbuton3" "(done_dialog 3)")<br />   (action_tile "bgbuton2" "(done_dialog 2)")<br />   (setq next (start_dialog))<br />   (cond<br />     ((and (= next 1) tems) (show-mode (setq *bgtxt-val* tems)));;按确定键赋值有效<br />     ((= next 2)(putvalue 6 (getdist "\n请输入右侧间距 或 <点取>: "))(putvalue 9 0)(putvalue 8 0))<br />     ((= next 3)(putvalue 4 (getdist "\n请输入左侧间距 或 <点取>: "))(putvalue 9 0)))<br /> )<br />   (unload_dialog dcl_id)<br /> (princ)<br /> )<br /> <br /> ;;DCL取值函数<br /> (defun dclvalue()<br /> (mapcar '(lambda(x) (cons (car x) (read (get_tile (car x))))) *bgtxt-val*)<br /> )<br /> (defun putvalue(n i / s)<br /> (setq s (car (nth n *bgtxt-val*))<br />     *bgtxt-val* (subst (cons s i)(assoc s *bgtxt-val*) *bgtxt-val*))<br /> )<br /> (defun bgthesame(s)<br /> (if (= s "1")(progn<br /> (set_tile "bgtext6" (get_tile "bgtext4"))<br /> (set_tile "bgtext7" (get_tile "bgtext5"))))<br /> )<br /> <br /> (defun bgtxtssdcl()<br /> '("bgtext:dialog {label="表格内文字对齐";spacer_1;"<br /> ":boxed_column{label="水平对齐";"<br /> ":row{:radio_button{key="bgtext0";label="左(&L)";}"<br /> "    :radio_button{key="bgtext1";label="中(&M)";}"<br /> "    :radio_button{key="bgtext2";label="右(&R)";}"<br /> "    :radio_button{key="bgtext3";label="分散(&F)";}}}"<br /> ":boxed_column {label="缩进距离";"<br /> ":row{:edit_box{key="bgtext4";label="左侧(&A)";}"<br /> ":button{label=".<";key="bgbuton3";fixed_width=true;}"<br /> ":popup_list{key="bgtext5";}}"<br /> ":row{:edit_box{key="bgtext6";label="右侧(&B)";}"<br /> ":button{label=".<";key="bgbuton2";fixed_width=true;}"<br /> ":popup_list{key="bgtext7";}}:spacer{height=0.1;}"<br /> ":row{:toggle{label="按字符宽度";key="bgtext9";}"<br /> ":toggle{label="对称缩进";key="bgtext8";}}}"<br /> ":row{:spacer{width=0.2;}:toggle{label="删除文字前空格";"<br /> " key="bgtext10";}:spacer{width=20;}}"<br /> " spacer_1;:row{spacer_1;"<br /> ":button{label="确定";key="bgbuton1";is_default=true;}"<br /> ":button{label="取消";key="bgbuton0";is_cancel=true;}"<br /> " spacer_1;}spacer_1;}"))<br /> <br /> (princ)<br />

yxp

qq1254582201 发表于 2018-5-3 10:56
网上有网友那你的程序赚钱呢，赶紧投诉他http:// www.lisp123.com/wbl/2015/0129/440.html

果然是的，免费就罢了，竟然还收费，太不地道了。
没地方投诉啊，这网站就是他的

tranney

兄弟，你的这个程序非常好，又是源码，可惜不能竖向对齐，

能不能加上一个竖向中心对齐啊，感谢ing

qq1254582201

网上有网友那你的程序赚钱呢，赶紧投诉他http:// www.lisp123.com/wbl/2015/0129/440.html

注册

正事所需的，谢谢

hhhlike

好像用过后会改变文字的宽度

云中孤鹰

这个非常不错

669423907

程序改变了用户设置的字体的宽度因子。谢谢楼主分享。

cnks

来顶贴的，支持！

tianyi1230

好东西，应该上个演示的，增强一下大家的下载欲望。感谢了

tianyi1230

测试过了，提出个建议，能否加个竖向对齐，不仅仅有水平对齐选项。

成仔

好东西，支持源码分享，感谢了

gtj116600

这个确实是好东东呀，赶快下载。