[编程申请]：对以W开头的字符串执行操作后由左边变成右边

lengliqun

对以W开头的字符串执行操作后由左边变成右边
W2?12变成Y2?12
W2?12/2变成Y2X2?12
W2?12/3变成Y3X2?12
W2?14/3变成Y3X2?14
W2?12/5变成Y5X2?12
余类推，特征是
1、只对以W开头的字符串才改变
2、将W变成Y
3、将/a变成aX插入到Y的后面

能用于CAD2002及以下版本的LSP
以下有附件可供测试，谢谢。

PLgis

;下面的程序段已测试通过，供参考。

2. 
   
3. (defun c:W2Y(/ ss sn si i ed d1 d11 pos dlast)
   
4.   (setq ss(ssget "x" (list(cons 0 "TEXT"))))
   
5.   (setq sn(if ss(sslength ss) 0))
   
6.   (setq i 0)
   
7.   (while(< i sn)
   
8.     (setq si(ssname ss i) ed(entget si) d1(cdr(assoc 1 ed)))
   
9.     (if(= (substr d1 1 1) "W")
   
10.       (progn
    
11.         (setq pos(getPos d1))
    
12.         (cond
    
13.           (pos
    
14.              (setq dlast(substr d1 (1+ pos)))
    
15.              (setq d11(strcat "Y" dlast "X" (substr d1 2 (- pos 2))))
    
16.           )
    
17.           (t
    
18.              (setq d11(strcat "Y" (substr d1 2)))
    
19.           )
    
20.         )
    
21.         (setq ed(subst (cons 1 d11)(assoc 1 ed) ed))
    
22.         (entmod ed)
    
23.       )
    
24.     )
    
25.     (setq i(1+ i))
    
26.   )
    
27.   (alert "W->Y结束。")
    
28.   (princ)
    
29. )
    
30. ;
    
31. (defun getPos(ws / n j pos)
    
32.   (setq n(strlen ws) j 2)
    
33.   (while(and(< j n)(not pos))
    
34.     (if(= (substr ws j 1) "/")
    
35.       (setq pos j)
    
36.     )
    
37.     (setq j(1+ j))
    
38.   )
    
39.   pos
    
40. )
    
41. ;
    

<br /> (defun c:W2Y(/ ss sn si i ed d1 d11 pos dlast)<br />   (setq ss(ssget "x" (list(cons 0 "TEXT"))))<br />   (setq sn(if ss(sslength ss) 0))<br />   (setq i 0)<br />   (while(< i sn)<br />     (setq si(ssname ss i) ed(entget si) d1(cdr(assoc 1 ed)))<br />     (if(= (substr d1 1 1) "W")<br />       (progn<br />         (setq pos(getPos d1))<br />         (cond<br />           (pos<br />              (setq dlast(substr d1 (1+ pos)))<br />              (setq d11(strcat "Y" dlast "X" (substr d1 2 (- pos 2))))<br />           )<br />           (t<br />              (setq d11(strcat "Y" (substr d1 2)))<br />           )<br />         )<br />         (setq ed(subst (cons 1 d11)(assoc 1 ed) ed))<br />         (entmod ed)<br />       )<br />     )<br />     (setq i(1+ i))<br />   )<br />   (alert "W->Y结束。")<br />   (princ)<br /> )<br /> ;<br /> (defun getPos(ws / n j pos)<br />   (setq n(strlen ws) j 2)<br />   (while(and(< j n)(not pos))<br />     (if(= (substr ws j 1) "/")<br />       (setq pos j)<br />     )<br />     (setq j(1+ j))<br />   )<br />   pos<br /> )<br /> ;<br />

zxq0220

程序:

2. 
   
3. ;晓东 zxq0220
   
4. ;对以W开头的字符串执行操作后由左边变成右边
   
5. ;W2?12变成Y2?12
   
6. ;W2?12/2变成Y2X2?12
   
7. ;W2?12/3变成Y3X2?12
   
8. ;W2?14/3变成Y3X2?14
   
9. ;W2?12/5变成Y5X2?12
   
10. ;余类推，特征是
    
11. ;1、只对以W开头的字符串才改变
    
12. ;2、将W变成Y
    
13. ;3、将/a变成aX插入到Y的后面
    
14. (DEFUN C:CHSTR2 ()
    
15. (IF (SETQ SS (SSGET "X" '((0 . "TEXT") (1 . "W*")))) (PROGN
    
16.   (SETQ I 0)
    
17.   (REPEAT (SSLENGTH SS)
    
18.    (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)
    
19.          STR (CDR (ASSOC 1 ENT))
    
20.          STL (STRLEN STR)
    
21.          J 1)
    
22.    (IF (WCMATCH STR "W*/*") (PROGN
    
23.     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) "/")) (SETQ J (1+ J)))
    
24.     (SETQ STR1 (STRCAT "Y" (SUBSTR STR (1+ J)) "X" (SUBSTR STR 2 (- J 2))))
    
25.    )
    
26.     (SETQ STR1 (STRCAT "Y" (SUBSTR STR 2)))
    
27.    )
    
28.    (SETQ ENT (SUBST (CONS 1 STR1) (CONS 1 STR) ENT))
    
29.    (ENTMOD ENT)
    
30.   )
    
31. ))
    
32. (PRINC)
    
33. )
    

<br /> ;晓东 zxq0220<br /> ;对以W开头的字符串执行操作后由左边变成右边<br /> ;W2?12变成Y2?12<br /> ;W2?12/2变成Y2X2?12<br /> ;W2?12/3变成Y3X2?12<br /> ;W2?14/3变成Y3X2?14<br /> ;W2?12/5变成Y5X2?12<br /> ;余类推，特征是<br /> ;1、只对以W开头的字符串才改变<br /> ;2、将W变成Y<br /> ;3、将/a变成aX插入到Y的后面<br /> (DEFUN C:CHSTR2 ()<br /> (IF (SETQ SS (SSGET "X" '((0 . "TEXT") (1 . "W*")))) (PROGN<br />   (SETQ I 0)<br />   (REPEAT (SSLENGTH SS)<br />    (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)<br />          STR (CDR (ASSOC 1 ENT))<br />          STL (STRLEN STR)<br />          J 1)<br />    (IF (WCMATCH STR "W*/*") (PROGN<br />     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) "/")) (SETQ J (1+ J)))<br />     (SETQ STR1 (STRCAT "Y" (SUBSTR STR (1+ J)) "X" (SUBSTR STR 2 (- J 2))))<br />    )<br />     (SETQ STR1 (STRCAT "Y" (SUBSTR STR 2)))<br />    )<br />    (SETQ ENT (SUBST (CONS 1 STR1) (CONS 1 STR) ENT))<br />    (ENTMOD ENT)<br />   )<br /> ))<br /> (PRINC)<br /> )<br />

lengliqun

谢谢PLgis和zxq0220  两大侠，CAD2002测试均可用。谢谢。