修改文字大小写的程序（源码）

ucuc2003

2. (Defun c:xdx ( / case)
   
3.   (command "redraw")
   
4.   (princ "\n修改文字的大小写，请选择文字")
   
5.   (setq fil (ssget'((0 . "TEXT,MTEXT"))))
   
6.   (setq case (getint "\n改成[小写(1)] <直接回车为大写>："))  
   
7. 
   
8.   (setq len (sslength fil))
   
9.   (setq n 0)
   
10. 
    
11. (while (<= n (- len 1))
    
12.   (progn
    
13.    (setq e (ssname fil n))
    
14.    (cond
    
15.         ((= "TEXT" (cdr (assoc 0 (setq ed (entget e)))))
    
16.           (progn
    
17.   
    
18.            (setq ostr (cdr (assoc 1 ed)))
    
19.            (setq nstr (strcase ostr case))
    
20.            (setq ed (subst (cons 1 nstr) (assoc 1 ed) ed))
    
21.            (setq n (+ 1 n))
    
22.            (entmod ed)
    
23.           ))
    
24.         ((= "MTEXT" (cdr (assoc 0 (setq ed (entget e)))))
    
25.           (progn
    
26.   
    
27.            (setq ostr (cdr (assoc 1 ed)))
    
28.            (setq nstr (strcase ostr case))
    
29.              (setq lenstr (strlen nstr))
    
30.               (setq m 1)
    
31.               (while (< m lenstr)
    
32.                 (if (= "\\p" (substr nstr m 2))
    
33.                   
    
34.                      (setq nstr (strcat (substr nstr 1 m) "\P" (substr nstr (+ 2 m))))
    
35.                  ;(setq m (+ 1 m))   
    
36.                 )
    
37.                  (setq m (+ 1 m))
    
38.               )
    
39. 
    
40.            (setq ed (subst (cons 1 nstr) (assoc 1 ed) ed))
    
41.            (setq n (+ 1 n))
    
42.            (entmod ed)
    
43.           ))
    
44.        (T (setq n (+ 1 n)))
    
45.     )
    
46.    )
    
47.   )
    
48. (princ)
    
49. );end defun

(Defun c:xdx ( / case) <br />   (command "redraw")<br />   (princ "\n修改文字的大小写，请选择文字")<br />   (setq fil (ssget'((0 . "TEXT,MTEXT"))))<br />   (setq case (getint "\n改成[小写(1)] <直接回车为大写>："))  <br /> <br />   (setq len (sslength fil))<br />   (setq n 0)<br /> <br /> (while (<= n (- len 1))<br />   (progn<br />    (setq e (ssname fil n))<br />    (cond <br />         ((= "TEXT" (cdr (assoc 0 (setq ed (entget e)))))<br />           (progn<br />   <br />            (setq ostr (cdr (assoc 1 ed)))<br />            (setq nstr (strcase ostr case))<br />            (setq ed (subst (cons 1 nstr) (assoc 1 ed) ed)) <br />            (setq n (+ 1 n))<br />            (entmod ed)<br />           ))<br />         ((= "MTEXT" (cdr (assoc 0 (setq ed (entget e)))))<br />           (progn<br />   <br />            (setq ostr (cdr (assoc 1 ed)))<br />            (setq nstr (strcase ostr case))<br />              (setq lenstr (strlen nstr))<br />               (setq m 1)<br />               (while (< m lenstr)<br />                 (if (= "\\p" (substr nstr m 2))<br />                    <br />                      (setq nstr (strcat (substr nstr 1 m) "\P" (substr nstr (+ 2 m))))<br />                  ;(setq m (+ 1 m))   <br />                 )<br />                  (setq m (+ 1 m))<br />               )<br /> <br />            (setq ed (subst (cons 1 nstr) (assoc 1 ed) ed)) <br />            (setq n (+ 1 n))<br />            (entmod ed)<br />           ))<br />        (T (setq n (+ 1 n)))<br />     )<br />    )<br />   )<br /> (princ)<br /> );end defun

sixth

是源码的就要支持一下，好东西

ketxu

I use Tcase of Express also. Thanks for sharing

疯球

谢谢分享     

zyhandw

楼主厚道，是源码的就要顶！

永不言弃

顶起来

l18c19

修改文字大小写的程序（源码） ，值得学习！

月饮寒烟楼

支持一个！！！路过

潇湘飞雨

支持  学习下  

清风明月名字

路过学习学习。谢谢分享！

朽木大师

好工具，要学习

不语勿语

谢谢分享