[求助]：请指教错在哪里

露水2

我自己编写了一个为r14的以文字中心改文字大小的程序
但是没有达到自己的预期效果不知道问题出在哪里？
请指教？
最好在我的原来基础上找出错误（学习阶段，主要想知道自己错在哪里）

2. 
   
3. (defun c:test()
   
4.    (setq h (getreal "\n文字高度:"))
   
5.    (setq ss (ssget))
   
6. (setq enn (entlast))
   
7.    (setq n 0)
   
8. (repeat (sslength ss)
   
9.          (setq en (ssname ss n))
   
10.          
    
11.          (setq en_data (entget en))
    
12.          (setq en_type (cdr (assoc 0 en_data)))
    
13. 
    
14.     (if (= en_type "TEXT")
    
15.        (progn
    
16.            (command "ucs" "e" en)
    
17. (setq en_high (cdr (assoc 40 en_data)))
    
18. 
    
19.            (setq box (textbox en_data))
    
20.            (setq pt1 (car box))
    
21.            (setq pt3 (cadr box))
    
22.            (setq pt2 (list (car pt3) (cadr pt1)))
    
23.            (setq pt4 (list (car pt1) (cadr pt3)))
    
24.            (setq mid (inters pt1 pt3 pt2 pt4))
    
25.            (setq i (/ h en_high))
    
26.            (command "scale" enn "" mid i)
    
27.        )
    
28.    )
    
29. )
    
30. )

<br /> (defun c:test()<br />    (setq h (getreal "\n文字高度:"))<br />    (setq ss (ssget))<br /> (setq enn (entlast))<br />    (setq n 0)<br /> (repeat (sslength ss)<br />          (setq en (ssname ss n))<br />          <br />          (setq en_data (entget en))<br />          (setq en_type (cdr (assoc 0 en_data)))<br /> <br />     (if (= en_type "TEXT")<br />        (progn <br />            (command "ucs" "e" en)<br /> (setq en_high (cdr (assoc 40 en_data)))<br /> <br />            (setq box (textbox en_data)) <br />            (setq pt1 (car box))<br />            (setq pt3 (cadr box))<br />            (setq pt2 (list (car pt3) (cadr pt1)))<br />            (setq pt4 (list (car pt1) (cadr pt3)))<br />            (setq mid (inters pt1 pt3 pt2 pt4))<br />            (setq i (/ h en_high))<br />            (command "scale" enn "" mid i)<br />        )<br />    )<br /> )<br /> )

yshf

;改为如下程序即可基本满足要求
(defun c:test()
(setq h (getreal "\n文字高度:"))
(setq ss (ssget))
;(setq enn (entlast))删除该行
(setq n 0)
(repeat (sslength ss)
(setq en (ssname ss n))

(setq en_data (entget en))
(setq en_type (cdr (assoc 0 en_data)))

(if (= en_type "TEXT")
(progn
(command "ucs" "e" en)
(setq en_high (cdr (assoc 40 en_data)))

(setq box (textbox en_data))
(setq pt1 (car box))
(setq pt3 (cadr box))
(setq pt2 (list (car pt3) (cadr pt1)))
(setq pt4 (list (car pt1) (cadr pt3)))
(setq mid (inters pt1 pt3 pt2 pt4))
(setq i (/ h en_high))
(command "scale" en "" mid i);该行有改动
)
)
)
)

xyp1964

2. [FONT=courier new]
   
3. ;;;以文字中心改文字大小
   
4. (defun c:test ()
   
5.   (setq        h  (getreal "\n文字高度 : ")
   
6.         ss (ssget '((0 . "TEXT")))        ;直接过滤TEXT实体简化以后的程序
   
7.                                         ;enn (entlast);无用
   
8.         n  0
   
9.   )
   
10.   (repeat (sslength ss)
    
11.     (setq en          (ssname ss n)
    
12.           en_data (entget en)
    
13.     )
    
14.     (command "ucs" "e" en)
    
15.     (setq en_high (cdr (assoc 40 en_data))
    
16.           box          (textbox en_data)
    
17.           pt1          (car box)
    
18.           pt3          (cadr box)
    
19.           pt2          (list (car pt3) (cadr pt1))
    
20.           pt4          (list (car pt1) (cadr pt3))
    
21.           mid          (inters pt1 pt3 pt2 pt4)
    
22.           i          (/ h en_high)
    
23.           n          (1+ n)                ;新加，否则无法循环
    
24.     )
    
25.     ;;(command "scale" enn "" mid i);;; enn 应改成循环后的实体en
    
26.     (command "scale" en "" mid i)
    
27.   )
    
28.   (princ) ;新加，屏蔽回显
    
29. )[/FONT]

[FONT=courier new]<br /> ;;;以文字中心改文字大小<br /> (defun c:test ()<br />   (setq        h  (getreal "\n文字高度 : ")<br />         ss (ssget '((0 . "TEXT")))        ;直接过滤TEXT实体简化以后的程序<br />                                         ;enn (entlast);无用<br />         n  0<br />   )<br />   (repeat (sslength ss)<br />     (setq en          (ssname ss n)<br />           en_data (entget en)<br />     )<br />     (command "ucs" "e" en)<br />     (setq en_high (cdr (assoc 40 en_data))<br />           box          (textbox en_data)<br />           pt1          (car box)<br />           pt3          (cadr box)<br />           pt2          (list (car pt3) (cadr pt1))<br />           pt4          (list (car pt1) (cadr pt3))<br />           mid          (inters pt1 pt3 pt2 pt4)<br />           i          (/ h en_high)<br />           n          (1+ n)                ;新加，否则无法循环<br />     )<br />     ;;(command "scale" enn "" mid i);;; enn 应改成循环后的实体en<br />     (command "scale" en "" mid i)<br />   )<br />   (princ) ;新加，屏蔽回显<br /> )[/FONT]

eachy

getreal -> getdist

露水2

谢谢各位搞定了
还想问xyp1964两个问题
一：在这个程序中(command "ucs" "e" en)起什么作用。
二：在学习中我时常见到(setvar "cmdecho" 0) 这句的作用是什么，有或者没有好象都没有什么变化。

狂刀

1. 其实没什么用
2. 是控制cad命令回显的系统参数。

eachy

2. 
   
3. (defun c:tt (/ ss ssl n oldos el e n pl pcen oldos h zh scl)
   
4.   (if (and (setq h (getdist "\nHeight: "))
   
5.            (setq ss (ssget '((0 . "Text")))))
   
6.     (progn
   
7.       (setq ssl          (sslength ss)
   
8.             n          0
   
9.             oldos (getvar "osmode")
   
10.       )
    
11.       (setvar "osmode" 0)
    
12.       (repeat ssl
    
13.         (setq el (entget (setq e (ssname ss n)))
    
14.               n         (1+ n)
    
15.               zh (cdr (assoc 40 el))
    
16.               scl (/ h zh)
    
17.         )
    
18.         (setq pl   (textbox el)
    
19.               pcen (trans (mapcar '+
    
20.                                   (cdr (assoc 10 el))
    
21.                                   (mapcar '(lambda (x) (/ x 2.))
    
22.                                           (mapcar '+ (car pl) (cadr pl))
    
23.                                   )
    
24.                           )
    
25.                           0
    
26.                           1
    
27.                    )
    
28.         )
    
29.         (command ".scale" e "" pcen scl)
    
30.       )
    
31.       (setvar "osmode" oldos)
    
32.     )
    
33.   )
    
34.   (princ)
    
35. )
    

<br /> (defun c:tt (/ ss ssl n oldos el e n pl pcen oldos h zh scl) <br />   (if (and (setq h (getdist "\nHeight: "))<br />            (setq ss (ssget '((0 . "Text")))))<br />     (progn<br />       (setq ssl          (sslength ss)<br />             n          0<br />             oldos (getvar "osmode")<br />       )<br />       (setvar "osmode" 0)<br />       (repeat ssl<br />         (setq el (entget (setq e (ssname ss n)))<br />               n         (1+ n)<br />               zh (cdr (assoc 40 el))<br />               scl (/ h zh)<br />         )<br />         (setq pl   (textbox el)<br />               pcen (trans (mapcar '+<br />                                   (cdr (assoc 10 el))<br />                                   (mapcar '(lambda (x) (/ x 2.))<br />                                           (mapcar '+ (car pl) (cadr pl))<br />                                   )<br />                           )<br />                           0<br />                           1<br />                    )<br />         )<br />         (command ".scale" e "" pcen scl)<br />       )<br />       (setvar "osmode" oldos)<br />     )<br />   )<br />   (princ)<br /> )<br />

xyp1964

再用“通用函数”写一个：

2. [FONT=courier new]
   
3. (load "xyp_lib")
   
4. ;|加载通用函数(可在签名栏直接下载)
   
5. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
6. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
7. ★1·在acad.lsp中增加(load"xyp_lib")
   
8. ■2·在每个程序内增加(load"xyp_lib")
   
9. ■3·在command下，输入(load"xyp_lib")
   
10. ■4·在菜单.mnl中增加(load"xyp_lib")
    
11. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
    
12. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
13. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
14. [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]
    
15. |;
    
16. 
    
17. ;;;以文字中心改文字大小
    
18. (defun c:test (/ ss n en st pt)
    
19.   (cmdla0)
    
20.   (setq        h  (UREAL 7 "" "\n输入新文字高度" h)
    
21.         ss (ssget '((0 . "TEXT")))
    
22.         n  -1
    
23.   )
    
24.   (while (setq en (ssname ss (setq n (1+ n))))
    
25.     (setq st (/ h (cdr (assoc 40 (entget en))) 1.0)
    
26.           pt (xyp-get-MidPoint
    
27.                (xyp-get-MinMaxPoint en 0)
    
28.                (xyp-get-MinMaxPoint en 1)
    
29.              )
    
30.     )
    
31.     (command "scale" en "" pt st)
    
32.   )
    
33.   (cmdla1)
    
34. )[/FONT]

[FONT=courier new]<br /> (load "xyp_lib")<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib")<br /> ■2·在每个程序内增加(load"xyp_lib")<br /> ■3·在command下，输入(load"xyp_lib")<br /> ■4·在菜单.mnl中增加(load"xyp_lib")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]<br /> |;<br /> <br /> ;;;以文字中心改文字大小<br /> (defun c:test (/ ss n en st pt)<br />   (cmdla0)<br />   (setq        h  (UREAL 7 "" "\n输入新文字高度" h)<br />         ss (ssget '((0 . "TEXT")))<br />         n  -1<br />   )<br />   (while (setq en (ssname ss (setq n (1+ n))))<br />     (setq st (/ h (cdr (assoc 40 (entget en))) 1.0)<br />           pt (xyp-get-MidPoint<br />                (xyp-get-MinMaxPoint en 0)<br />                (xyp-get-MinMaxPoint en 1)<br />              )<br />     )<br />     (command "scale" en "" pt st)<br />   )<br />   (cmdla1)<br /> )[/FONT]