求高手出马，对单行文字，删除后缀，并加前缀

xyxy

请高手出马！
程序要求，输入命令后，程序自动完成以下动作。先自动选择cad中含有以“yz”结尾的单行文字（如123yz，acd2yz，789513yz等），然后针对此选择集删除后缀“yz”，并加上前缀“xy”。如123yz变成xy123，acd2yz变成xyacd2，789513yz变成xy789513。谢谢！

Andyhon

只通过附件之调试

2. 
   
3. (defun C:xy7yz ()
   
4.   (setq ss (ssget "X" '((0 . "TEXT") (1 . "*yz")))
   
5.         i  0
   
6.   )
   
7. 
   
8.   (while (setq ee (ssname ss i))
   
9.     (setq obj (vlax-ename->vla-object ee)
   
10.           txt (vla-get-textstring obj)
    
11.           txt (vl-string-subst "" "yz" txt)
    
12.           i   (1+ i)
    
13.     )
    
14.     (vla-put-textstring obj (strcat "xy" txt))
    
15.   )
    
16. )
    

<br /> (defun C:xy7yz ()<br />   (setq ss (ssget "X" '((0 . "TEXT") (1 . "*yz")))<br />         i  0<br />   )<br /> <br />   (while (setq ee (ssname ss i))<br />     (setq obj (vlax-ename->vla-object ee)<br />           txt (vla-get-textstring obj)<br />           txt (vl-string-subst "" "yz" txt)<br />           i   (1+ i)<br />     )<br />     (vla-put-textstring obj (strcat "xy" txt))<br />   )<br /> )<br />

yanguangfei

简单査看子符串函数，选择集组码1 .  写成   ＊YZ

Andyhon

请附上调试用的对映文件(Dwg)

xyxy

Andyhon 发表于 2012-6-28 10:46
请附上调试用的对映文件(Dwg)

Andyhon你好，附件已上传，请下载，非常感谢出手相助！

zyhandw

我也简单写了一个，方法较笨

2. (defun c:ss(/ n ss ssna sslst str strnew strnew2 sslst2)
   
3.   (setq n 0)
   
4.   (if (setq ss (ssget "x" '((0 . "text") (1 . "*yz"))))
   
5.       (repeat (sslength ss)
   
6.         (setq ssna (ssname ss n))
   
7.         (setq sslst (entget ssna))
   
8.         (setq str (cdr (assoc '1 sslst)))
   
9.         (setq strnew (vl-string-right-trim "yz" str))
   
10.         (setq strnew2 (strcat "xy" strnew))
    
11.         (setq sslst2 (subst (cons 1 strnew2) (assoc '1 sslst) sslst))
    
12.         (entmod sslst2)
    
13.         (entupd ssna)
    
14.         (setq n (1+ n))
    
15.       )
    
16.   )
    
17.   (princ)
    
18. )
    
19. (prompt "\n程序运行命令为ss")

(defun c:ss(/ n ss ssna sslst str strnew strnew2 sslst2)<br />   (setq n 0)<br />   (if (setq ss (ssget "x" '((0 . "text") (1 . "*yz"))))<br />       (repeat (sslength ss)<br />         (setq ssna (ssname ss n))<br />         (setq sslst (entget ssna))<br />         (setq str (cdr (assoc '1 sslst)))<br />         (setq strnew (vl-string-right-trim "yz" str))<br />         (setq strnew2 (strcat "xy" strnew))<br />         (setq sslst2 (subst (cons 1 strnew2) (assoc '1 sslst) sslst))<br />         (entmod sslst2)<br />         (entupd ssna)<br />         (setq n (1+ n))<br />       )<br />   )<br />   (princ)<br /> )<br /> (prompt "\n程序运行命令为ss")

Andyhon

;;; 比如JL-1、WL-1，框选后输入2，则两个编号变成JL-2、WL-2

2. 
   
3. (defun C:str-NewN ()
   
4.   (setq ss (ssget "X" '((0 . "TEXT") (1 . "*-#")))
   
5.        Num (getstring "\n新的编号: ")
   
6.         i  0
   
7.   )
   
8. 
   
9.   (while (setq ee (ssname ss i))
   
10.     (setq obj (vlax-ename->vla-object ee)
    
11.           txt (vla-get-textstring obj)
    
12.           txt (reverse (vl-string->list txt))
    
13.           txt (vl-list->string (reverse (cdr txt)))
    
14.           i   (1+ i)
    
15.     )
    
16.     (vla-put-textstring obj (strcat txt Num))
    
17.   )
    
18. )
    

<br /> (defun C:str-NewN ()<br />   (setq ss (ssget "X" '((0 . "TEXT") (1 . "*-#")))<br />        Num (getstring "\n新的编号: ") <br />         i  0<br />   )<br /> <br />   (while (setq ee (ssname ss i))<br />     (setq obj (vlax-ename->vla-object ee)<br />           txt (vla-get-textstring obj)<br />           txt (reverse (vl-string->list txt))<br />           txt (vl-list->string (reverse (cdr txt)))<br />           i   (1+ i)<br />     )<br />     (vla-put-textstring obj (strcat txt Num))<br />   )<br /> )<br />

半听可乐

Andyhon 发表于 2012-9-25 08:47
;;; 比如JL-1、WL-1，框选后输入2，则两个编号变成JL-2、WL-2

怎么不能选择呢？

vlisp2012

不用选择了，全图纸中的全改完成了！
默认的全图纸中的文字

luyu9635

来个加前缀和后缀一起的
                    ;文字加前缀或后缀
(defun C:adt (/ i ss qh ee obj txt)
  (setq i 0)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (INITGET "A B NIL")
      (setq qh(getkword "\n前缀<A>\后缀<B>:<A>"))
                 (if (not qh)
                   (setq qh  "A" str (getstring "\n输入前缀:") )
                   (setq qh  "B" str (getstring "\n输入后缀:"))

                   )
                   (while(setq ee (ssname ss i))
                        (setq obj (vlax-ename->vla-object ee) txt (vla-get-textstring obj) i   (1+ i))
                                   (vla-put-textstring obj
                                     (cond ((= "A" qh) (strcat str txt))
                                           ((= "B" qh) (strcat txt str))
                                           )
                                     )
                                   )
                 )
           )
    )