[求助]：我与LISP不得不说的故事

xbx7920

图面上有几行单行文本，为了从右边对齐它们，我编了个小LISP，
如下：
(defun c:rt ()
  (princ "\n把单行文本从右边对齐！")
  (setq old (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq en (entsel "\nselect source text:"))
  (setq endata (entget(car en)))
  (setq enbox (textbox endata))
  (setq enp3 (cadr enbox))
  (setq ss (ssget))
  (setq i 0)
  (repeat (sslength ss)
        (setq ssn (ssname ss i))
        (setq ssdata (entget ssn))
        (setq box (textbox ssdata))
        (setq p3 (cadr box))
        (setq p4 (list (car enp3) (cadr p3)))
        (command ".move" ssn p3 p4 )
        (setq i (1+ i))
  )
  (setvar "cmdecho" old)
  (princ)
)
加载后却出现以下问题：
Command: rt
把单行文本从右边对齐！
select source text:
Select objects: Other corner: 1 found

Select objects:


Select objects:
Base point or displacement:
请高手帮我看看，不吝赐教，谢谢先。

lt_zzy

将(setq en (entsel "\nselect source text:"))
换成(setq en (ssget "\nselect source text:"))
可能会好一些。

lt_zzy

我这里也有一个，支持多种对齐方式。

2. 
   
3.   [FONT=courier new]
   
4. (defun c:dq(/ sblip scmde pp ent sel p num No ed b n x y xyzold xold yold new old)
   
5.    (setq sblip (getvar "blipmode"))               ;取得是否显示坐标点
   
6.    (setq scmde (getvar "cmdecho"))                ;取得是否显示提示
   
7.    (setq os (getvar "osmode"))                    ;取得是否显示物体捕捉
   
8.    (setvar "blipmode" 0)
   
9.    (setvar "cmdecho" 0)
   
10.    (command "undo""group")
    
11.    (princ "  水平对齐一行文本或垂直对齐一列文本!")
    
12.    (setq ent (ssget '((0 . "TEXT"))))
    
13.    (setq sel (getint "\n   1.水平对齐 2.垂直对齐 <水平对齐>"))
    
14.    (if (null sel) (setq sel 1) )
    
15.    (setq ducs (getvar "worlducs"))
    
16.    (if (= ducs 0)
    
17.        (progn
    
18.           (command "ucs" "w")
    
19.        )
    
20.    )
    
21.    (if (= sel 1)
    
22.        (progn
    
23.           (setq p (getpoint "\n  对齐后一行的统一底线位置（选点）："))
    
24.           (setq y (cadr p))
    
25.        )
    
26.        (progn
    
27.           (setq pp (getint "\n   1.左对齐  2.对中  3.右对齐 <右对齐>"))
    
28.           (if (null pp) (setq pp 3) )
    
29.           (setq pp (1- pp))
    
30.           (setq p (getpoint "\n 对齐后一列的统一垂直位置（选点）："))
    
31.           (setq x (car p))
    
32.        )
    
33.    )
    
34.    (setq num (sslength ent))
    
35.    (setq n 0)
    
36.    (setvar "osmode" 0)
    
37.    (if (= sel 1)                   ;水平对齐
    
38.       (progn
    
39.          (repeat num
    
40.            (setq No (ssname ent n))        ;取实体名
    
41.            (setq ed (entget No))           ;取该名的实体关联表
    
42.            (setq xyzold (cdr (assoc 11 ed)))
    
43.            (setq xold (car xyzold))
    
44.            (if (/= xold 0)
    
45.              (progn
    
46.                (entmod ed)
    
47.                (setq new (list xold y '0))
    
48.              )
    
49.              (progn
    
50.                (setq xyzold (cdr (assoc 10 ed)))
    
51.                (setq xold (car xyzold))
    
52.                (entmod ed)
    
53.                (setq new (list xold y '0))
    
54.              )
    
55.            )
    
56.            (setq angold (cdr (assoc 50 ed)))
    
57.            (if (= angold 90)
    
58.              (setq ed (subst (cons 72 '1) (assoc 72 ed) ed))
    
59.            )
    
60.            (setq ed (subst (cons 73 '1) (assoc 73 ed) ed))
    
61.            (setq ed (subst (cons 11 new) (assoc 11 ed) ed))
    
62.            (entmod ed)
    
63.            (setq n (1+ n))
    
64.          )
    
65.       )
    
66.       (progn                       ;垂直对齐
    
67.          (repeat num
    
68.            (setq No (ssname ent n))        ;取实体名
    
69.            (setq ed (entget No))           ;取该名的实体关联表
    
70.            (setq xyzold (cdr (assoc 10 ed)))   ;提取文字插入点原座标
    
71.            (setq yold (cadr xyzold))
    
72.            (setq ed (subst (cons 72 pp) (assoc 72 ed) ed))
    
73.            (setq ed (subst (cons 73 '1) (assoc 73 ed) ed))
    
74.            (entmod ed)
    
75.            (setq new (list x yold '0))
    
76.            (setq ed (subst (cons 11 new) (assoc 11 ed) ed))
    
77.            (entmod ed)
    
78.            (setq n (1+ n))
    
79.          )
    
80.       )
    
81.    )
    
82.    (command "undo""end")
    
83.    (setvar "blipmode" sblip)
    
84.    (setvar "cmdecho" scmde)
    
85.    (setvar "osmode"os)
    
86.    (princ)
    
87. )
    
88.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:dq(/ sblip scmde pp ent sel p num No ed b n x y xyzold xold yold new old)<br />    (setq sblip (getvar "blipmode"))               ;取得是否显示坐标点<br />    (setq scmde (getvar "cmdecho"))                ;取得是否显示提示<br />    (setq os (getvar "osmode"))                    ;取得是否显示物体捕捉<br />    (setvar "blipmode" 0)<br />    (setvar "cmdecho" 0)<br />    (command "undo""group")<br />    (princ "  水平对齐一行文本或垂直对齐一列文本!")<br />    (setq ent (ssget '((0 . "TEXT"))))<br />    (setq sel (getint "\n   1.水平对齐 2.垂直对齐 <水平对齐>"))<br />    (if (null sel) (setq sel 1) )<br />    (setq ducs (getvar "worlducs"))<br />    (if (= ducs 0)<br />        (progn<br />           (command "ucs" "w")<br />        )<br />    )<br />    (if (= sel 1)<br />        (progn<br />           (setq p (getpoint "\n  对齐后一行的统一底线位置（选点）："))<br />           (setq y (cadr p))<br />        )<br />        (progn<br />           (setq pp (getint "\n   1.左对齐  2.对中  3.右对齐 <右对齐>"))<br />           (if (null pp) (setq pp 3) )<br />           (setq pp (1- pp))<br />           (setq p (getpoint "\n 对齐后一列的统一垂直位置（选点）："))<br />           (setq x (car p))<br />        )<br />    )<br />    (setq num (sslength ent))<br />    (setq n 0)<br />    (setvar "osmode" 0)<br />    (if (= sel 1)                   ;水平对齐<br />       (progn<br />          (repeat num<br />            (setq No (ssname ent n))        ;取实体名<br />            (setq ed (entget No))           ;取该名的实体关联表<br />            (setq xyzold (cdr (assoc 11 ed)))<br />            (setq xold (car xyzold))<br />            (if (/= xold 0)<br />              (progn<br />                (entmod ed)<br />                (setq new (list xold y '0))<br />              )<br />              (progn<br />                (setq xyzold (cdr (assoc 10 ed)))<br />                (setq xold (car xyzold))<br />                (entmod ed)<br />                (setq new (list xold y '0))<br />              )<br />            )<br />            (setq angold (cdr (assoc 50 ed)))<br />            (if (= angold 90)<br />              (setq ed (subst (cons 72 '1) (assoc 72 ed) ed))<br />            )<br />            (setq ed (subst (cons 73 '1) (assoc 73 ed) ed))<br />            (setq ed (subst (cons 11 new) (assoc 11 ed) ed))<br />            (entmod ed)<br />            (setq n (1+ n))<br />          )<br />       )<br />       (progn                       ;垂直对齐<br />          (repeat num<br />            (setq No (ssname ent n))        ;取实体名<br />            (setq ed (entget No))           ;取该名的实体关联表<br />            (setq xyzold (cdr (assoc 10 ed)))   ;提取文字插入点原座标<br />            (setq yold (cadr xyzold))<br />            (setq ed (subst (cons 72 pp) (assoc 72 ed) ed))<br />            (setq ed (subst (cons 73 '1) (assoc 73 ed) ed))<br />            (entmod ed)<br />            (setq new (list x yold '0))<br />            (setq ed (subst (cons 11 new) (assoc 11 ed) ed))<br />            (entmod ed)<br />            (setq n (1+ n))<br />          )<br />       )<br />    )<br />    (command "undo""end")<br />    (setvar "blipmode" sblip)<br />    (setvar "cmdecho" scmde)<br />    (setvar "osmode"os)<br />    (princ)<br /> )<br />   [/FONT]<br />

xbx7920

斑竹老大，用(setq en (entsel "\nselect source text:"))我是想以所选的TEXT做为对齐的标准啊！

lt_zzy

最初由 xbx7920 发布
[B]斑竹老大，用(setq en (entsel "\nselect source text:"))我是想以所选的TEXT做为对齐的标准啊！ [/B]

对不起，看来我是没有读懂你的程序，我再好好看看吧！

xbx7920

这到底是怎么回事？没人理我，算了，回家吧！

XDSoft

最初由 xbx7920 发布
[B]图面上有几行单行文本，为了从右边对齐它们，我编了个小LISP，
如下：
(defun c:rt ()
  (princ "\n把单行文本从右边对齐！")
  (setq old (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq en (entsel "\... [/B]

运行后的问题你没有说清楚，你详细说下，和你的想法有什么不对的地方？

xbx7920

加载后却出现以下问题：
Command: rt
把单行文本从右边对齐！
select source text:
Select objects: Other corner: 1 found
Select objects:
Select objects:
Base point or displacement:
显然是让我用MOVE来手工移动文字。
麻烦XDSOFT帮我看看！谢了。

lsjjm

修改程序还不如现编一个来得快. 下面的程序码可以满足你的要求! 稍作改动还可满足其他对齐方式:
(defun c:test ( / ss)
  (vl-load-com)
  (princ "\nRight alignment!")
  (setq ent0 (car (entsel "\nSelect Source Text:")))
  (setq obj0 (vlax-ename->vla-object ent0))
  (ptt obj0)
  (setq pl p1 pr p2)
  (prompt "\Select Alignment Text:")
  (setq ss (ssget) n 0)
  (while (< n (sslength ss))
    (setq ent (ssname ss n))
    (setq obj (vlax-ename->vla-object ent))
    (ptt obj)
    (vla-put-alignment obj 8)
    (vla-put-TextAlignmentPoint obj (vlax-3d-point (list (car pr)(cadr p2))))
    (setq n (1+ n))
  )
)
(defun pt (obj)
  (vla-getboundingbox obj 'p1 'p2)
  (setq p1 (vlax-safearray->list p1)
        p2 (vlax-safearray->list p2))
)

xbx7920

还是不行啊，出现问题如下：
Command: ap

Loading C:\Documents and Settings\采购\桌面\复件 3d.lsp ...

Command: test error: null function
(VL-LOAD-COM)
(C:TEST)
*Cancel*
为何？我很郁闷，我自己原来的LISP到底是哪里出现了问题？

ll_j

就事论事，问题出在(command ".move" ssn p3 p4 )一句，应该为(command ".move" ssn "" p3 p4 )。
程序运行后文本不能调整，需要再查查几个相关的点。
我也有一个对齐的程序，比lt_zzy 斑竹的更罗嗦些，见http://www.xdcad.net/forum/showthread.php?threadid=27605中ju.lsp。

eachy

最初由 xbx7920 发布
[B]还是不行啊，出现问题如下：
Command: ap

Loading C:\Documents and Settings\采购\桌面\复件 3d.lsp ...

Command: test error: null function
(VL-LOAD-COM)
(C:TEST)
*Cancel*
为何？我很郁闷，我自己?.. [/B]

(vl-load-com) 运行在2000+以上，你用的是 R14 吧。

aeo

可能是(command ".move" ssn p3 p4 )应该为(command ".move" ssn ""p3 p4 )

xbx7920

多谢诸位的大力相助，我回去再试一试。LT-ZZY斑竹提供的对齐LISP很好也很完善，但我觉得唯一不足的地方就是对齐之后，所选的TEXT（全部的）位置全都变了。能不能以一个TEXT为基准位置不变，别的TXET向它对齐呢？

lt_zzy

最初由 xbx7920 发布
[B]多谢诸位的大力相助，我回去再试一试。LT-ZZY斑竹提供的对齐LISP很好也很完善，但我觉得唯一不足的地方就是对齐之后，所选的TEXT（全部的）位置全都变了。能不能以一个TEXT为基准位置不变，别的TXET向它对齐呢？ [/B]

你选择你要将别的文本对齐到的文本的位置不就可以了吗？