将框选所有图元中的文字小写改为大写

清风明月10

;命令将框选所有图元中的文字小写改为大写.lsp
(defun c:TT( / n textn textnlst textss)
  ; (command "-style" "方正细等线体" "FZXDXJW.TTF" "1.0" "1.0" "0" "N" "N")
  (setq textss (ssget '((0 . "*text"))))
  (setq n 0)
  (repeat (sslength textss)
    (setq textn (ssname textss n))
    (setq textnlst (entget textn))
    (setq textnlst (subst (cons  1  (strcase (CDR(assoc 1 textnlst)) ))(assoc 1 textnlst) textnlst))
    (entmod textnlst)                                                        `
    (setq n (1+ n))
  )
(princ)
)

st788796

对照着普及下API

1. (defun c:tt (/ ss)
   
2.   (if (setq ss (ssget '((0 . "*text"))))
   
3.     (mapcar '(lambda (x)
   
4.                (xdrx_setpropertyvalue
   
5.                  x
   
6.                  "Textstring"
   
7.                  (strcase (xdrx_getpropertyvalue x "Textstring"))
   
8.                )
   
9.              )
   
10.             (xdrx_pickset->ents ss)
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

(defun c:tt (/ ss)<br />   (if (setq ss (ssget '((0 . "*text"))))<br />     (mapcar '(lambda (x)<br />                (xdrx_setpropertyvalue<br />                  x<br />                  "Textstring"<br />                  (strcase (xdrx_getpropertyvalue x "Textstring"))<br />                )<br />              )<br />             (xdrx_pickset->ents ss)<br />     )<br />   )<br />   (princ)<br /> )

st788796

再借用一个

1. (defun c:tt ()
   
2.   (fy:clearcset)
   
3.   (if (ssget '((0 . "*text")))
   
4.     (mapcar '(lambda (x)
   
5.                (vla-put-textstring x (strcase (vla-get-textstring x)))
   
6.              )
   
7.             (fy:cset->objs)
   
8.     )
   
9.   )
   
10.   (princ)
    
11. )

(defun c:tt ()<br />   (fy:clearcset)<br />   (if (ssget '((0 . "*text")))<br />     (mapcar '(lambda (x)<br />                (vla-put-textstring x (strcase (vla-get-textstring x)))<br />              )<br />             (fy:cset->objs)<br />     )<br />   )<br />   (princ)<br /> )

st788796

更正下，mtext非textstring

pxt2015

多年前的老帖子，被强大的搜索功能找出来；非常欣慰的是老程序还能使用。
光大写没意思，借花献佛，增加一个开关，可自由设置大、小写。

(defun c:tt1 (/ is is_dx_tt1 note ss)                       
  (xdrx_begin)
  (setq is t)
  (while is
    (setq note (strcat "\n大写or小写："
                       (if is_dx_tt1         "小写"         "大写"  )
                       "\n选择文字改大小写[切换(D)] <退出>:"
               )
    )
    ;;==============================
    ;;不能使用的关键字 A C F G L M P R U W
    (Xdrx_initget "D")
    (Xdrx_initssget Note "D" "" "" "")
    (Setq Ss (Xdrx_ssget ":s" '((0 . "*text"))))
    ;;==============================
    (cond
      ((null ss) (SETQ is NIL))
      ((= "D" SS) (setq is_dx_tt1 (not is_dx_tt1)))
      (ss
       (mapcar '(lambda        (x)
                  (Xdrx_SetpropertyValue
                    x    "TextString"
                    (if is_dx_tt1
                      (strcase (Xdrx_GetpropertyValue x "TextString") t)
                      (strcase (Xdrx_GetpropertyValue x "TextString"))
                      )
                  )
                )
               (xdrx_pickset->ents ss)
       )
      )
    )
  )
  (xdrx_end)
  (princ)
)