批量改文字高度

print1985

凑个热闹，带对话框的，以前写的。DCL文件请放到cad支持目录下，命令zg。

1993063

1. (DEFUN C:TH (/ SSET I TXTHEIGHT TEXTSIZE)   (VL-LOAD-COM) (SETQ I 0)
   
2.   (SETQ SSET (SSGET ":s" '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>"))))
   
3.   (IF SSET
   
4.     (PROGN
   
5.       (SETQ TEXTSIZE (* (GETVAR "DIMTXT") (GETVAR "DIMSCALE")))
   
6.       (SETQ TXTHEIGHT (GETDIST (STRCAT "\n指定文字的高度 字高:<< " (RTOS TEXTSIZE) " >> ")))
   
7.       (IF (= TXTHEIGHT NIL)(SETQ TXTHEIGHT TEXTSIZE))
   
8.       (REPEAT (SSLENGTH SSET)
   
9.         (VLA-PUT-HEIGHT (VLAX-ENAME->VLA-OBJECT (SSNAME SSET I)) TXTHEIGHT)
   
10.         (SETQ I (1+ I))
    
11.       )
    
12.     )
    
13.   )(if (= nil sset)(princ"\n*没选择文字*"))
    
14.   (PRINC)
    
15. ) ;改字高到当前标注文字高度

(DEFUN C:TH (/ SSET I TXTHEIGHT TEXTSIZE)   (VL-LOAD-COM) (SETQ I 0)<br />   (SETQ SSET (SSGET ":s" '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>"))))<br />   (IF SSET<br />     (PROGN<br />       (SETQ TEXTSIZE (* (GETVAR "DIMTXT") (GETVAR "DIMSCALE")))<br />       (SETQ TXTHEIGHT (GETDIST (STRCAT "\n指定文字的高度 字高:<< " (RTOS TEXTSIZE) " >> ")))<br />       (IF (= TXTHEIGHT NIL)(SETQ TXTHEIGHT TEXTSIZE))<br />       (REPEAT (SSLENGTH SSET)<br />         (VLA-PUT-HEIGHT (VLAX-ENAME->VLA-OBJECT (SSNAME SSET I)) TXTHEIGHT)<br />         (SETQ I (1+ I))<br />       )<br />     )<br />   )(if (= nil sset)(princ"\n*没选择文字*"))<br />   (PRINC)<br /> ) ;改字高到当前标注文字高度

xyp1964

2. 
   
3. (defun c:tt ()
   
4.   (setq th (Udist 7 "" "字高<输入或鼠标直接量取>" th nil))
   
5.   (if (setq ss (ssget '((0 . "*TEXT"))))
   
6.     (xyp-SubUpd ss 40 th)
   
7.   )
   
8.   (princ)
   
9. )

<br /> (defun c:tt ()<br />   (setq th (Udist 7 "" "字高<输入或鼠标直接量取>" th nil))<br />   (if (setq ss (ssget '((0 . "*TEXT"))))<br />     (xyp-SubUpd ss 40 th)<br />   )<br />   (princ)<br /> )

pzweng

xyp1964 发表于 2012-7-22 00:24

简洁了，用了一个2个自定义函数

pzweng

1993063 发表于 2012-7-21 23:28

这个思路不错

pzweng

print1985 发表于 2012-7-19 15:51
凑个热闹，带对话框的，以前写的。DCL文件请放到cad支持目录下，命令zg。

嗯，还不错，我可以学学

preone

x_s_s_1 发表于 2012-7-18 09:56
支持源码，搞了一个短点的，但是只针对text，共同学习

    (entmod(reverse(cons new_num (reverse  ent))))
请教 上句是做什么用的？ 是把new_num放至ent联合列表的末尾么？这样会不会ent联合列表里有两个new_num点对表？这样的话 entmod后的效果是什么样的？不明白~  

半听可乐

很好的程序，感谢楼主分享！提个小建议：1.“选取两点(D)”这个选项选择之后，两点之间的高差（y坐标差值）应该就是想要的字高，但如果选择两点的高差比较小（比如200），得到的字体最终高度貌似大于200；2.能不能增加个动态字体大小选项？

duuudu

1993063 发表于 2012-7-21 23:28

这个不错，看来还是要多用用vla函数，真简洁

duuudu

x_s_s_1 发表于 2012-7-18 09:56
支持源码，搞了一个短点的，但是只针对text，共同学习

(apply '(lambda (x) (ch_dxf x 40 ww))
应该不需要apply函数，直接(ch_dxf (ssname SS (setq N (1- N))) 40 ww)不是也可以么