[LISP程序]：修改文字高度(源码)

jiega

2. 
   
3. ;;;修改字高  
   
4. (defun c:ModTxtHeight(/ ss txsize n index ent style oldsize newsize ent1)
   
5.   (setvar "CMDECHO" 0)
   
6.   (setq ss (ssget))
   
7.   (if ss
   
8.     (progn
   
9.       (if (= txsize_new nil)
   
10.         (setq txsize_new 3.0)
    
11.       )
    
12.       (setq
    
13.         txsize (getreal
    
14.                  (strcat "\n输入新的字高:<" (rtos txsize_new 2 2) ">")
    
15.                )
    
16.       )
    
17.       (if (= txsize nil)
    
18.         (setq txsize txsize_new)
    
19.         (setq txsize_new txsize)
    
20.       )
    
21.       (setq n (sslength ss))
    
22.       (setq index 0)
    
23.       (repeat n
    
24.         (setq ent (entget (ssname ss index)))
    
25.         (setq index (+ 1 index))
    
26.         (setq style (assoc 0 ent))
    
27.         (if (= "TEXT" (cdr style))
    
28.           (progn
    
29.             (setq oldsize (assoc 40 ent))
    
30.             (setq newsize (cons (car oldsize) txsize))
    
31.             (setq ent1 (subst newsize oldsize ent))
    
32.             (entmod ent1)
    
33.           )
    
34.         )
    
35.       )
    
36.     )
    
37.   )
    
38.   (setvar "CMDECHO" 1)
    
39.   (princ)
    
40. )
    

<br /> ;;;修改字高  <br /> (defun c:ModTxtHeight(/ ss txsize n index ent style oldsize newsize ent1)<br />   (setvar "CMDECHO" 0)<br />   (setq ss (ssget))<br />   (if ss<br />     (progn<br />       (if (= txsize_new nil)<br />         (setq txsize_new 3.0)<br />       )<br />       (setq<br />         txsize (getreal<br />                  (strcat "\n输入新的字高:<" (rtos txsize_new 2 2) ">")<br />                )<br />       )<br />       (if (= txsize nil)<br />         (setq txsize txsize_new)<br />         (setq txsize_new txsize)<br />       )<br />       (setq n (sslength ss))<br />       (setq index 0)<br />       (repeat n<br />         (setq ent (entget (ssname ss index)))<br />         (setq index (+ 1 index))<br />         (setq style (assoc 0 ent))<br />         (if (= "TEXT" (cdr style))<br />           (progn<br />             (setq oldsize (assoc 40 ent))<br />             (setq newsize (cons (car oldsize) txsize))<br />             (setq ent1 (subst newsize oldsize ent))<br />             (entmod ent1)<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (setvar "CMDECHO" 1)<br />   (princ)<br /> )<br />

它山之石

scaletext命令

qjcpj

使用qselect及属性命令来得更快。

marcoyuwen

程序中应考虑U操作。

nyfzh

学习 了！

kkt123

程序中应考虑U操作:)

lampcsz

修改文字高度(源码)