[求助]：抽空编写了个改字体高度的程序,但有点错误,请大家帮忙检查一下

水炮眼大侠

2. (defun c:ttv()
   
3.   (setq h(getdist "\n 输入文本新的字高："))
   
4.   (setq e(entnext))
   
5.   (while e
   
6.     (setq e1(entget e))
   
7.      (if(= "text" (cdr(assoc 0 e1)))
   
8.         (progn
   
9.          (setq e1(subst (cons 40 h) (assoc 40 e1) e1))
   
10.              (if (= 3 (cdr (assoc 72 e1)))
    
11.                  (setq e1(subst (cons 72 0) (assoc 72 e1) e1))
    
12.              )
    
13. 
    
14.             (entmod e1)
    
15.            )
    
16.        )
    
17.        (setq e(entnext e))
    
18.        )
    
19.        (princ)
    
20.      )

(defun c:ttv()<br />   (setq h(getdist "\n 输入文本新的字高："))<br />   (setq e(entnext))<br />   (while e<br />     (setq e1(entget e))<br />      (if(= "text" (cdr(assoc 0 e1)))<br />         (progn<br />          (setq e1(subst (cons 40 h) (assoc 40 e1) e1))<br />              (if (= 3 (cdr (assoc 72 e1)))<br />                  (setq e1(subst (cons 72 0) (assoc 72 e1) e1))<br />              )<br /> <br />             (entmod e1)<br />            )<br />        )<br />        (setq e(entnext e))<br />        )<br />        (princ)<br />      )

eachy

为什么不用 sclaetext  命令呢？

命令输入 scaletext

选择对象: 使用对象选择方法并在完成时按 ENTER 键

输入缩放的基点选项 [现有(E)/对齐(A)/调整(F)/中心(C)/中间(M)/右(R)/左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)] <现有>: 指定一个位置作为缩放基点

按照基点提示，可以选择某个位置作为缩放基点，供每个选定的文字对象单独使用。 缩放基点位于文字选项的一个插入点处，但是即使选项与选择插入点时的选项相同，文字对象的对正也不受影响。

上面显示的基点选项在 TEXT 命令中有说明。 除了“对齐”、“调整”和“左”文字选项与左下 (BL) 多行文字附着点相同外，单行文字的基点选项与多行文字的基点选项类似。

指定文字高度或 [匹配对象(M)/缩放比例(S)] <0.5000>: 指定文字高度或输入选项

  

匹配对象
缩放最初选定的文字对象以与选定文字对象的大小匹配。

选择具有所需高度的文字对象: 选择要匹配的文字对象

  

比例因子
按参照长度和指定的新长度缩放所选文字对象。

指定比例因子或 [参照(R)]: 指定比例因子或输入 r

比例因子

通过输入比例因子的数值来缩放所选文字对象。

参照

相对参照长度和新长度来缩放选定的文字对象。

指定参照长度 <1>: 输入长度作为参照距离

指定新长度: 比较参照长度输入另一长度

选定文字将按新长度和参照长度中输入的值进行缩放。 如果新长度小于参照长度，选定的文字对象将缩小。

snoopychen

把"text"改成"TEXT"应该就可以了，在我这里的cad2004可以通过使用。
(= "TEXT" (cdr (assoc 0 e1)))
这个可以通过设置断点知道没有进入IF里面来得知

水炮兄一直在3d版出没，有空也来Lisp版走走：）
这个程序采用entnext的方式来全图修改，好像灵活性不够，不过按键更少就是，另外，按照eachy版主的说法，把程序中的局部变量提取出来写是写程序的一个好习惯。
chtext.lsp也是改字高的好程序啊

水炮眼大侠

有点不对啊!好像与修改"TEXT"无关,请看下面两张图

                               
登录/注册后可看大图

                               
登录/注册后可看大图

东南西北中发白

如果为了学编程，你就捣鼓吧！从这样的简单程序着手比较好，
如果为了实用，放弃吧！Scaletext比你这程序好用，

已经有的功能再去编，多此一举！
高版本已经增加了的功能不用继续不舍得抛弃自编的程序，固步自封！

eachy

如果你为了编程就要好好看看 Help 中的 DXF 部分，Text 采用 Align 方式的时候，Height 是忽略的。这样写才是正解

2. 
   
3. (defun c:ttv (/ ss ssl h i e el)
   
4.   (if (and (setq h (getdist "\n Input Text Height: "))
   
5.            (setq ss (ssget "x" '((0 . "text"))))
   
6.       )
   
7.     (progn
   
8.       (setq ssl        (sslength ss)
   
9.             i        -1
   
10.       )
    
11.       (repeat ssl
    
12.         (setq e         (ssname ss (setq i (1+ i)))
    
13.               el (entget e)
    
14.         )
    
15.         (princ "\rTotle ")
    
16.         (princ ssl)
    
17.         (princ " Text, Change No.")
    
18.         (princ (1+ i))
    
19.         (princ " Text...")
    
20.         (if (= 3 (cdr (assoc 72 el)))
    
21.           (setq el (subst '(72 . 0) (assoc 72 el) el))
    
22.         )
    
23.         (entmod        (subst (cons 40 h) (assoc 40 el) el))
    
24.       )
    
25.     )   
    
26.   )
    
27.   (princ)
    
28. )

<br /> (defun c:ttv (/ ss ssl h i e el)<br />   (if (and (setq h (getdist "\n Input Text Height: "))<br />            (setq ss (ssget "x" '((0 . "text"))))<br />       )<br />     (progn<br />       (setq ssl        (sslength ss)<br />             i        -1<br />       )<br />       (repeat ssl<br />         (setq e         (ssname ss (setq i (1+ i)))<br />               el (entget e)<br />         )<br />         (princ "\rTotle ")<br />         (princ ssl)<br />         (princ " Text, Change No.")<br />         (princ (1+ i))<br />         (princ " Text...")<br />         (if (= 3 (cdr (assoc 72 el)))<br />           (setq el (subst '(72 . 0) (assoc 72 el) el))<br />         )<br />         (entmod        (subst (cons 40 h) (assoc 40 el) el))<br />       )<br />     )    <br />   )<br />   (princ)<br /> )

水炮眼大侠

发老弟,高版本的功能我不是不知道,任何事情都得从简单的开始吗?

感谢eachy  大哥的帮忙!我去试一下,看看能否成功.