ucuc2003 发表于 2012-12-22 03:37:20

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

(Defun c:xdx ( / case)
(command "redraw")
(princ "\n修改文字的大小写，请选择文字")
(setq fil (ssget'((0 . "TEXT,MTEXT"))))
(setq case (getint "\n改成[小写(1)] <直接回车为大写>："))

(setq len (sslength fil))
(setq n 0)

(while (<= n (- len 1))
(progn
   (setq e (ssname fil n))
   (cond
      ((= "TEXT" (cdr (assoc 0 (setq ed (entget e)))))
          (progn

         (setq ostr (cdr (assoc 1 ed)))
         (setq nstr (strcase ostr case))
         (setq ed (subst (cons 1 nstr) (assoc 1 ed) ed))
         (setq n (+ 1 n))
         (entmod ed)
          ))
      ((= "MTEXT" (cdr (assoc 0 (setq ed (entget e)))))
          (progn

         (setq ostr (cdr (assoc 1 ed)))
         (setq nstr (strcase ostr case))
             (setq lenstr (strlen nstr))
            (setq m 1)
            (while (< m lenstr)
                (if (= "\\p" (substr nstr m 2))
                  
                     (setq nstr (strcat (substr nstr 1 m) "\P" (substr nstr (+ 2 m))))
               ;(setq m (+ 1 m))   
                )
               (setq m (+ 1 m))
            )

         (setq ed (subst (cons 1 nstr) (assoc 1 ed) ed))
         (setq n (+ 1 n))
         (entmod ed)
          ))
       (T (setq n (+ 1 n)))
    )
   )
)
(princ)
);end defun

sixth 发表于 2013-9-5 09:49:55

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

ketxu 发表于 2019-10-31 22:41:32

I use Tcase of Express also. Thanks for sharing

疯球 发表于 2018-6-25 15:52:21


谢谢分享   

zyhandw 发表于 2012-12-22 15:21:29

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

永不言弃 发表于 2012-12-23 13:36:08

顶起来

l18c19 发表于 2013-8-21 07:52:15

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

月饮寒烟楼 发表于 2013-8-21 09:38:46

支持一个！！！路过

潇湘飞雨 发表于 2013-8-23 10:37:05

支持学习下

清风明月名字 发表于 2013-8-26 19:59:49

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

朽木大师 发表于 2013-8-31 00:04:38

好工具，要学习

不语勿语 发表于 2018-5-28 22:46:15

谢谢分享   
页: [1] 2 3
查看完整版本: 修改文字大小写的程序（源码）