[LISP程序]：文本工具：文字序号增值

梦断江南

2. 
   
3.   [FONT=courier new]
   
4. (princ "\ntadd====txt add 文字序号增值 -----------lxx.2001.7")
   
5. (defun c:tadd ()
   
6.   (princ "\ntadd====txt add 文字序号增值-----------lxx.2001.7")
   
7.   (setq ss (ssget '((0 . "TEXT")))
   
8.         nadd (getint "\n增加值<1>:")
   
9.         dec (getint "\n精度<0>:")
   
10.         i 0)
    
11.   (if (not nadd)(setq nadd 1))
    
12.   (if (not dec)(setq dec 0))
    
13.   (repeat (sslength ss)
    
14.     (setq ent (ssname ss i)
    
15.           entl (entget ent)
    
16.           i (1+ i)
    
17.     )
    
18.     (txtadd entl nadd dec)
    
19.   )
    
20.   (princ)
    
21. )
    
22. ;;;;;txtadd
    
23. (defun txtadd (entl nadd dec /)
    
24.   (setq        bnam0 (cdr(assoc 1 entl)));;;old txt
    
25.   (princ "\n原字串:")(princ bnam0)
    
26.   ;;使得序号不重复
    
27.   (setq nlen (strlen bnam0)
    
28.         n1 1
    
29.         lastn nil)
    
30.   (while (and (/= 0 nlen)(member (substr bnam0 nlen 1) '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ".")))
    
31.         (setq lastn (atof (substr bnam0 nlen n1));;字串尾序号
    
32.               nlen (1- nlen)
    
33.               n1 (1+ n1)
    
34.         )
    
35.   );;end while
    
36.   (if lastn;;;;;;;;确定新字串---尾序号累加nadd,无序号加nadd
    
37.    (progn (setq lastn (+ lastn nadd))
    
38.           (if (or (= 'INT (type (read bnam0))) (= 'REAL (type (read bnam0))));;当字串如"3"                       
    
39.               (setq bnam (rtos lastn 2 dec))
    
40.               (setq bnam (strcat (substr bnam0 1 nlen) (rtos lastn 2 dec)))
    
41.           )
    
42.    )
    
43.    (progn (setq lastn nadd)         ;;else
    
44.           (if (or (= 'INT (type (read bnam0)))(= 'REAL (type (read bnam0))))
    
45.               (setq bnam (rtos lastn 2 dec))
    
46.               (setq bnam (strcat bnam0 (rtos lastn 2 dec)))
    
47.           )
    
48.    )
    
49.   );;end if
    
50.   (princ " 改为:")(princ bnam)
    
51.   (setq entl (subst (cons 1 bnam) (assoc 1 entl) entl))
    
52.   (entmod entl)(entupd ent)
    
53. )
    
54.                
    
55.                      
    
56.       
    
57.   
    
58.   [/FONT]
    

<br />   [FONT=courier new]<br /> (princ "\ntadd====txt add 文字序号增值 -----------lxx.2001.7")<br /> (defun c:tadd ()<br />   (princ "\ntadd====txt add 文字序号增值-----------lxx.2001.7")<br />   (setq ss (ssget '((0 . "TEXT")))<br />         nadd (getint "\n增加值<1>:")<br />         dec (getint "\n精度<0>:")<br />         i 0)<br />   (if (not nadd)(setq nadd 1))<br />   (if (not dec)(setq dec 0))<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i)<br />           entl (entget ent)<br />           i (1+ i)<br />     )<br />     (txtadd entl nadd dec)<br />   )<br />   (princ)<br /> )<br /> ;;;;;txtadd<br /> (defun txtadd (entl nadd dec /)<br />   (setq        bnam0 (cdr(assoc 1 entl)));;;old txt<br />   (princ "\n原字串:")(princ bnam0)<br />   ;;使得序号不重复<br />   (setq nlen (strlen bnam0)<br />         n1 1<br />         lastn nil)<br />   (while (and (/= 0 nlen)(member (substr bnam0 nlen 1) '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ".")))<br />         (setq lastn (atof (substr bnam0 nlen n1));;字串尾序号<br />               nlen (1- nlen)<br />               n1 (1+ n1)<br />         )<br />   );;end while<br />   (if lastn;;;;;;;;确定新字串---尾序号累加nadd,无序号加nadd<br />    (progn (setq lastn (+ lastn nadd))<br />           (if (or (= 'INT (type (read bnam0))) (= 'REAL (type (read bnam0))));;当字串如"3"                        <br />               (setq bnam (rtos lastn 2 dec))<br />               (setq bnam (strcat (substr bnam0 1 nlen) (rtos lastn 2 dec)))<br />           )<br />    )<br />    (progn (setq lastn nadd)         ;;else<br />           (if (or (= 'INT (type (read bnam0)))(= 'REAL (type (read bnam0))))<br />               (setq bnam (rtos lastn 2 dec))<br />               (setq bnam (strcat bnam0 (rtos lastn 2 dec)))<br />           )<br />    )<br />   );;end if<br />   (princ " 改为:")(princ bnam)<br />   (setq entl (subst (cons 1 bnam) (assoc 1 entl) entl))<br />   (entmod entl)(entupd ent)<br /> )<br />                <br />                      <br />        <br />   <br />   [/FONT]<br />