求可记忆的修改文字与标注文字高度的代码

lucas_3333

明经朋友们，你们好！
求助一个支持框选改文字高度同标注文字高度的代码，修改字高后能记忆，下次输入文字和标注时自动沿用上次记忆的高度，但不要将没有选中的文字高度同标注文字高度改变！非常感谢！

该贴已经同步到 lucas_3333的微博

lucas_3333

可怜啊，没人帮助啊

lucas_3333

找了一下论坛，只有这些
改字高的：

1. (defun C:GZG ()
   
2. (setvar "CMDECHO" 0)
   
3. (prompt "\nSelection window")
   
4. (setq p1 (getpoint "\n第一角点: "))
   
5. (setq p2 (getcorner p1 "\n反向的角点: "))
   
6. (setq XTX (ssget "W" p1 p2))
   
7. (setq i -1)
   
8. (setq TSZ (getreal "\n输入字高 :"))
   
9. (repeat (sslength XTX)
   
10. (setq i (1+ i))
    
11. ;;;Changing textsize:
    
12. (setq SZ (cons 40 TSZ))
    
13. (setq ed (entget (ssname XTX i)))
    
14. (setq ed (subst SZ (assoc 40 ed) ed ))
    
15. (entmod ed)
    
16. );repeat
    
17. (princ)
    
18. );eof

(defun C:GZG ()<br /> (setvar "CMDECHO" 0)<br /> (prompt "\nSelection window")<br /> (setq p1 (getpoint "\n第一角点: "))<br /> (setq p2 (getcorner p1 "\n反向的角点: "))<br /> (setq XTX (ssget "W" p1 p2))<br /> (setq i -1)<br /> (setq TSZ (getreal "\n输入字高 :")) <br /> (repeat (sslength XTX)<br /> (setq i (1+ i))<br /> ;;;Changing textsize: <br /> (setq SZ (cons 40 TSZ))<br /> (setq ed (entget (ssname XTX i)))<br /> (setq ed (subst SZ (assoc 40 ed) ed ))<br /> (entmod ed)<br /> );repeat<br /> (princ)<br /> );eof

lucas_3333

一无所获啊，高手就帮帮忙呗

lucas_3333

可是对单行与多行文字有效，对标注文字没有效果，默认标注时字高都是2.5，运行程序将标注文字高度改到1后，再次标注，还是2.5的字高

1. (defun c:tt (/ hi ss)
   
2.   (fy:begin)
   
3.   (if (setq hi (getdist        (strcat        "\nTextSize<"
   
4.                                 (vl-princ-to-string (getvar "textsize"))
   
5.                                 ">: "
   
6.                         )
   
7.                )
   
8.       )
   
9.     (setvar "textsize" hi)
   
10.     (setq hi (getvar "textsize"))
    
11.   )
    
12.   (if (ssget '((0 . "*Text,Dim*")))
    
13.     (mapcar
    
14.       '(lambda (x / typ)
    
15.          (if (wcmatch (strcase (vla-get-objectname x))
    
16.                       "*DIM*"
    
17.              )
    
18.            (vlax-put x "TextHeight" hi)
    
19.            (vlax-put x "Height" hi)
    
20.          )
    
21.        )
    
22.       (fy:cset->objs)
    
23.     )
    
24.   )
    
25.   (fy:end)
    
26.   (princ)
    
27. )

(defun c:tt (/ hi ss)<br />   (fy:begin)<br />   (if (setq hi (getdist        (strcat        "\nTextSize<"<br />                                 (vl-princ-to-string (getvar "textsize"))<br />                                 ">: "<br />                         )<br />                )<br />       )<br />     (setvar "textsize" hi)<br />     (setq hi (getvar "textsize"))<br />   )<br />   (if (ssget '((0 . "*Text,Dim*")))<br />     (mapcar<br />       '(lambda (x / typ)<br />          (if (wcmatch (strcase (vla-get-objectname x))<br />                       "*DIM*"<br />              )<br />            (vlax-put x "TextHeight" hi)<br />            (vlax-put x "Height" hi)<br />          )<br />        )<br />       (fy:cset->objs)<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )

edata

我先理一下思路。
实现目的1，提示选择文本标注改字高2，将文本和标注 默认字高变量改变。
文本有系统变量控制，而标注只能新建替换样式实现。

edata

简单一句改
如果当前标注文字的样式字高不为0.00则失效，无论是标注或者文字都一样。

1. (defun c:tt (/ hi ss)
   
2.   (fy:begin)
   
3.   (if (setq hi (getdist        (strcat        "\nTextSize<"
   
4.                                 (vl-princ-to-string (getvar "textsize"))
   
5.                                 ">: "
   
6.                         )
   
7.                )
   
8.       )
   
9.     (setvar "textsize" hi)
   
10.     (setvar "dimtxt" hi)
    
11.     (setq hi (getvar "textsize"))
    
12.   )
    
13.   (if (ssget '((0 . "*Text,Dim*")))
    
14.     (mapcar
    
15.       '(lambda (x / typ)
    
16.          (if (wcmatch (strcase (vla-get-objectname x))
    
17.                       "*DIM*"
    
18.              )
    
19.            (vlax-put x "TextHeight" hi)
    
20.            (vlax-put x "Height" hi)
    
21.          )
    
22.        )
    
23.       (fy:cset->objs)
    
24.     )
    
25.   )
    
26.   (fy:end)
    
27.   (princ)
    
28. )

(defun c:tt (/ hi ss)<br />   (fy:begin)<br />   (if (setq hi (getdist        (strcat        "\nTextSize<"<br />                                 (vl-princ-to-string (getvar "textsize"))<br />                                 ">: "<br />                         )<br />                )<br />       )<br />     (setvar "textsize" hi)<br />     (setvar "dimtxt" hi)<br />     (setq hi (getvar "textsize"))<br />   )<br />   (if (ssget '((0 . "*Text,Dim*")))<br />     (mapcar<br />       '(lambda (x / typ)<br />          (if (wcmatch (strcase (vla-get-objectname x))<br />                       "*DIM*"<br />              )<br />            (vlax-put x "TextHeight" hi)<br />            (vlax-put x "Height" hi)<br />          )<br />        )<br />       (fy:cset->objs)<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )

lucas_3333

edata 发表于 2014-2-25 23:02
简单一句改
如果当前标注文字的样式字高不为0.00则失效，无论是标注或者文字都一样。

E大师，加载时显示“错误: 语法错误”
没想到标注这么难搞，我用燕秀工具箱时，有一个修改标注文字高度命令yx_dth ，使用后，再使用工具箱里的标注加强工具就能达到这个效果，用CAD自个的标注不行，不知这是什么原理？

429014673

这样画图不觉得累吗，画图要规范，你的图如果别人接手画，别人画得比你更累

edata

lucas_3333 发表于 2014-2-25 23:50
E大师，加载时显示“错误: 语法错误”
没想到标注这么难搞，我用燕秀工具箱时，有一个修改标注文字高度命 ...

没注意看代码；

1. (defun c:tt (/ hi ss)
   
2.   (fy:begin)
   
3.   (if (setq hi (getdist        (strcat        "\nTextSize<"
   
4.                                 (vl-princ-to-string (getvar "textsize"))
   
5.                                 ">: "
   
6.                         )
   
7.                )
   
8.       )
   
9.     (progn
   
10.     (setvar "textsize" hi)
    
11.     (setvar "dimtxt" hi)
    
12.     )
    
13.     (setq hi (getvar "textsize"))
    
14.   )
    
15.   (if (ssget '((0 . "*Text,Dim*")))
    
16.     (mapcar
    
17.       '(lambda (x / typ)
    
18.          (if (wcmatch (strcase (vla-get-objectname x))
    
19.                       "*DIM*"
    
20.              )
    
21.            (vlax-put x "TextHeight" hi)
    
22.            (vlax-put x "Height" hi)
    
23.          )
    
24.        )
    
25.       (fy:cset->objs)
    
26.     )
    
27.   )
    
28.   (fy:end)
    
29.   (princ)
    
30. )

(defun c:tt (/ hi ss)<br />   (fy:begin)<br />   (if (setq hi (getdist        (strcat        "\nTextSize<"<br />                                 (vl-princ-to-string (getvar "textsize"))<br />                                 ">: "<br />                         )<br />                )<br />       )<br />     (progn<br />     (setvar "textsize" hi)<br />     (setvar "dimtxt" hi)<br />     )<br />     (setq hi (getvar "textsize"))<br />   )<br />   (if (ssget '((0 . "*Text,Dim*")))<br />     (mapcar<br />       '(lambda (x / typ)<br />          (if (wcmatch (strcase (vla-get-objectname x))<br />                       "*DIM*"<br />              )<br />            (vlax-put x "TextHeight" hi)<br />            (vlax-put x "Height" hi)<br />          )<br />        )<br />       (fy:cset->objs)<br />     )<br />   )<br />   (fy:end)<br />   (princ)<br /> )