（完成）[编程申请]：晓东，请帮忙编一个文字对齐程序。

XDSoft

看了你的图，问几个问题：

对齐线是让用户自己定（一点），还是找文字中最靠近对齐线的实体定？

XDSoft

水平对齐是处理中英文分开写时候的问题吧？

我想可以有更好的方法解决，不用单独提个水平对齐的工具。

更好的方法是可以随时调整中英文间不同的高宽比，而且保证水平对齐。

ll_j

最初由 Tangent 发布
说明见图形附件。

http://www.xdcad.net/forum/showt ... mp;highlight=JU.lsp

Ju.lsp就是文本对其，不过插入点也调整了，试试吧。

eachy

最初由 Tangent 发布
[B]说明见图形附件。 [/B]

我也有一个。

2. 
   
3. ;|
   
4.    命令：txt_align
   
5.    
   
6.    功能：用于TEXT文字的排版
   
7.         可以把选定的多行TEXT文字按照“左、中、右”对齐方式排版
   
8.         程序去掉文字的前导和后缀空格，同时修改TEXT实体的对齐方式，
   
9.         方便以后的文字编辑保持对齐方式。
   
10. 
    
11.         程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
    
12.         LISP目录，自己加入到菜单里面就可以非常方便的使用了。
    
13.         关于程序的建议请到“晓东CAD空间-编程申请”论坛
    
14.         [url]http://www.xdcad.net/forum留言[/url]         
    
15.         
    
16. |;
    
17. (defun c:txt_align (/ ss basept basept1 sel txt box tstyl intl p)
    
18.   (prompt "\n请选取要排版的文字<退出>:")
    
19.   (if (and
    
20.         (setq ss (ssget '((0 . "text"))))
    
21.         (setq basept (getpoint "\n请拾取对齐位置点<退出>:"))
    
22.       )
    
23.     (progn
    
24.       (xdrx_begin)
    
25.       (xdrx_ucson)
    
26.       (initget 128 "L R M")
    
27.       (if (not (setq sel
    
28.                       (getkword
    
29.                         "\n对齐方式：[L -左对齐 / R -右对齐 / M -中心对齐]<L>:"
    
30.                       )
    
31.                )
    
32.           )
    
33.         (setq sel "L")
    
34.       )
    
35.       (xdrx_setsstodb ss 0)
    
36.       (while (setq e (xdrx_getentdata 0))
    
37.         (setq txt (xdrx_getentdxf 1)
    
38.               box (xdrx_entity_box e)
    
39.         )
    
40.         (setq basept1 (polar basept (/ pi 2) 100)
    
41.               intl    (inters
    
42.                         basept
    
43.                         basept1
    
44.                         (car box)
    
45.                         (cadr box)
    
46.                         nil
    
47.                       )
    
48.         )
    
49.         (setq txt (xdrx_string_trimLeft txt)
    
50.               txt (xdrx_string_trimRight txt)
    
51.         )
    
52.         (cond
    
53.           ((= "L" sel)
    
54.            (setq basept intl)
    
55.            (xdrx_modent 1 txt 72 0 11 '(0 0 0) 10 intl)
    
56.           )
    
57.           ((= "R" sel)
    
58.            (xdrx_modent 1 txt 11 intl 72 2)
    
59.           )
    
60.           ((= "M" sel)
    
61.            (xdrx_modent 1 txt 11 intl 72 4)
    
62.           )
    
63.         )
    
64.       )
    
65.       ;|(initget 128)
    
66.       (if (setq
    
67.             p (xdrx_dragssmove
    
68.                 "\n如需调整位置, 请点取要移到的位置 <不调整>: "
    
69.                 ss
    
70.                 basept
    
71.                 3
    
72.                 T
    
73.               )
    
74.           )
    
75.         (command ".move" ss "" basept p)
    
76.       )|;
    
77.       (xdrx_ucsoff)
    
78.       (xdrx_end)
    
79.     )
    
80.   )
    
81.   (princ)
    
82. )
    
83. 
    

<br /> ;|<br />    命令：txt_align<br />    <br />    功能：用于TEXT文字的排版<br />         可以把选定的多行TEXT文字按照“左、中、右”对齐方式排版<br />         程序去掉文字的前导和后缀空格，同时修改TEXT实体的对齐方式，<br />         方便以后的文字编辑保持对齐方式。<br /> <br />         程序配合XDRX_API build 20630＋版本使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的<br />         LISP目录，自己加入到菜单里面就可以非常方便的使用了。<br />         关于程序的建议请到“晓东CAD空间-编程申请”论坛<br />         [url]http://www.xdcad.net/forum留言[/url]         <br />         <br /> |;<br /> (defun c:txt_align (/ ss basept basept1 sel txt box tstyl intl p)<br />   (prompt "\n请选取要排版的文字<退出>:")<br />   (if (and<br />         (setq ss (ssget '((0 . "text"))))<br />         (setq basept (getpoint "\n请拾取对齐位置点<退出>:"))<br />       )<br />     (progn<br />       (xdrx_begin)<br />       (xdrx_ucson)<br />       (initget 128 "L R M")<br />       (if (not (setq sel<br />                       (getkword<br />                         "\n对齐方式：[L -左对齐 / R -右对齐 / M -中心对齐]<L>:"<br />                       )<br />                )<br />           )<br />         (setq sel "L")<br />       )<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (setq txt (xdrx_getentdxf 1)<br />               box (xdrx_entity_box e)<br />         )<br />         (setq basept1 (polar basept (/ pi 2) 100)<br />               intl    (inters<br />                         basept<br />                         basept1<br />                         (car box)<br />                         (cadr box)<br />                         nil<br />                       )<br />         )<br />         (setq txt (xdrx_string_trimLeft txt)<br />               txt (xdrx_string_trimRight txt)<br />         )<br />         (cond<br />           ((= "L" sel)<br />            (setq basept intl)<br />            (xdrx_modent 1 txt 72 0 11 '(0 0 0) 10 intl)<br />           )<br />           ((= "R" sel)<br />            (xdrx_modent 1 txt 11 intl 72 2)<br />           )<br />           ((= "M" sel)<br />            (xdrx_modent 1 txt 11 intl 72 4)<br />           )<br />         )<br />       )<br />       ;|(initget 128)<br />       (if (setq<br />             p (xdrx_dragssmove<br />                 "\n如需调整位置, 请点取要移到的位置 <不调整>: "<br />                 ss<br />                 basept<br />                 3<br />                 T<br />               )<br />           )<br />         (command ".move" ss "" basept p)<br />       )|;<br />       (xdrx_ucsoff)<br />       (xdrx_end)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

cy956

明经发过一个帖子，可以对齐任何实体，
用的是vla-GetBoundingBox求实体的框.

lhlaoyu

我用上面的程序怎么在2002下运行不了，清高人赐教。

lsjjm

看看我的程序码:

2. 
   
3. (defun ptt (ent)
   
4.   (setq obj (vlax-ename->vla-object ent))
   
5.   (vla-getboundingbox obj 'p1 'p2)
   
6.   (setq p1 (vlax-safearray->list p1)
   
7.         p2 (vlax-safearray->list p2))
   
8. )
   
9. (defun c:test ( / ss)   
   
10.   (vl-load-com)
    
11.   (initget "Left Middle Right")
    
12.   (setq k1 (getkword "\nAlgnment Style[Left/Middle/Right]:"))
    
13.   (setq ent0 (car (entsel "\nSelect Source Text:")))
    
14.   (ptt ent0)
    
15.   (setq pl p1 pr p2)
    
16.   (prompt "\Select Alignment Text:")
    
17.   (setq ss (ssget) n 0)
    
18.   (while (< n (sslength ss))
    
19.     (setq ent (ssname ss n))
    
20.     (setq obj (vlax-ename->vla-object ent))
    
21.     (ptt ent)
    
22.     (cond
    
23.       ((= k1 "Left")
    
24.         (vla-put-alignment obj 6)
    
25.         (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pl)(cadr p2)))))
    
26.       ((= k1 "Middle")
    
27.         (vla-put-alignment obj 10)
    
28.         (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pr)(cadr p2)))))
    
29.       ((= k1 "Right")
    
30.         (vla-put-alignment obj 8)
    
31.         (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pr)(cadr p2)))))
    
32.     );c
    
33.     (setq n (1+ n))
    
34.   )
    
35. )

<br /> (defun ptt (ent)<br />   (setq obj (vlax-ename->vla-object ent))<br />   (vla-getboundingbox obj 'p1 'p2)<br />   (setq p1 (vlax-safearray->list p1)<br />         p2 (vlax-safearray->list p2))<br /> )<br /> (defun c:test ( / ss)    <br />   (vl-load-com)<br />   (initget "Left Middle Right")<br />   (setq k1 (getkword "\nAlgnment Style[Left/Middle/Right]:"))<br />   (setq ent0 (car (entsel "\nSelect Source Text:")))<br />   (ptt ent0)<br />   (setq pl p1 pr p2)<br />   (prompt "\Select Alignment Text:")<br />   (setq ss (ssget) n 0)<br />   (while (< n (sslength ss))<br />     (setq ent (ssname ss n))<br />     (setq obj (vlax-ename->vla-object ent))<br />     (ptt ent)<br />     (cond<br />       ((= k1 "Left")<br />         (vla-put-alignment obj 6)<br />         (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pl)(cadr p2)))))<br />       ((= k1 "Middle")<br />         (vla-put-alignment obj 10)<br />         (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pr)(cadr p2)))))<br />       ((= k1 "Right")<br />         (vla-put-alignment obj 8)<br />         (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pr)(cadr p2)))))<br />     );c<br />     (setq n (1+ n))<br />   )<br /> )

speed_fisher

我们单位施工图向台巴子学习，图纸类似于表格形式（附图）
希望在文字对齐选项中加入对齐至表格单格范围中，并能自动
调节文字大小适应表格。

myfreemind

明经的那个对齐程序很好用！！

陌生人

楼上的是什么链接？能贴出来么？

myfreemind

www.mjtd.com的VBA版里有,你去找找!

雨中漫步0423

myfreemind
……没找到啊，你的网址找不到的
小雨想要这个程序，非常想要……