[LISP程序]：梁编号递增修改ss vb1.0--for结构

梦断江南

我不是搞结构的，呵呵，这回是应一位同事要求做的lsp。

2. 
   
3.   [FONT=courier new]
   
4. (princ "\n ttlsn----梁编号递增修改ss vb1.0--for结构------lxx.2001.11")
   
5. ;;
   
6. (defun c:ttlsn ( / n roop key ii ent)
   
7.   (princ "\nttlsn----梁编号递增修改v1.0---for结构------lxx.2001.11")
   
8.   (princ "\n!只针对前缀 kl xl 的梁编号txt!")
   
9.   (setq n (getint "\n起始编号<1>:")
   
10.         roop "true")
    
11.   (if (not n)(setq n 1))
    
12.   (while roop
    
13.    (initget "X C R  ")
    
14.    (setq key (getstring "\nX-退出/C-编号重复/R-重设编号/<选择梁编号>:"))
    
15.    (cond
    
16.     ((or (= "x" key)(= "X" key))
    
17.       (setq roop nil)
    
18.     );<X-退出>
    
19.     ((or (= "C" key)(= "c" key))
    
20.      (setq n (1- n))
    
21.      (princ "\n当前编号:")(princ n)
    
22.     );C-序号重复
    
23.     ((or (= "R" key)(= "r" key))
    
24.       (princ "\n当前编号:")(princ n)
    
25.       (setq n (getint "\n重设当前序号为:"))
    
26.     )
    
27.     ((= "" key)
    
28.      (princ "\n当前编号:")(princ n)
    
29.      (while (setq ss (ssget '((0 . "TEXT")(-4 . "< OR")(1 . "XL*")(1 . "KL*")(-4 . "OR >")) ))
    
30.        (setq ii 0)
    
31.        (repeat (sslength ss)
    
32.          (setq ent (ssname ss ii)
    
33.                  ii (1+ ii)
    
34.          )
    
35.          (chn)
    
36.        );end rep
    
37.        (princ "\n下一编号:")(princ  (1+ n))
    
38.        (setq n (1+ n))
    
39.      );end while
    
40.     )
    
41.    );end cond
    
42.   );end while
    
43. (princ)
    
44. )
    
45. ;;(chn)
    
46. (defun chn ( / entl e1 str1 i str2 i2 str3)
    
47.   (setq        entl (entget ent)
    
48.         e1   (cdr (assoc 1 entl))
    
49.         str1 (substr e1 1 2)
    
50.   )
    
51.      (if (= " " (substr e1 3 1))
    
52.        (setq i 3
    
53.              str1 (strcat str1 " ")
    
54.        )
    
55.        (setq i 2)
    
56.      )
    
57.      (setq str2        (substr e1 (1+ i))
    
58.            str2        (rtos (atoi str2) 2 0)
    
59.            i2        (strlen str2)
    
60.            str3        (substr e1 (+ i i2 1))
    
61.            e1        (strcat str1 (itoa n) str3)
    
62.            entl        (subst (cons 1 e1) (assoc 1 entl) entl)
    
63.      )
    
64.      (entmod entl)
    
65. )            
    
66.   
    
67.   [/FONT]
    

<br />   [FONT=courier new]<br /> (princ "\n ttlsn----梁编号递增修改ss vb1.0--for结构------lxx.2001.11")<br /> ;;<br /> (defun c:ttlsn ( / n roop key ii ent)<br />   (princ "\nttlsn----梁编号递增修改v1.0---for结构------lxx.2001.11")<br />   (princ "\n!只针对前缀 kl xl 的梁编号txt!")<br />   (setq n (getint "\n起始编号<1>:")<br />         roop "true")<br />   (if (not n)(setq n 1))<br />   (while roop<br />    (initget "X C R  ")<br />    (setq key (getstring "\nX-退出/C-编号重复/R-重设编号/<选择梁编号>:"))<br />    (cond<br />     ((or (= "x" key)(= "X" key))<br />       (setq roop nil)<br />     );<X-退出><br />     ((or (= "C" key)(= "c" key))<br />      (setq n (1- n))<br />      (princ "\n当前编号:")(princ n)<br />     );C-序号重复<br />     ((or (= "R" key)(= "r" key))<br />       (princ "\n当前编号:")(princ n)<br />       (setq n (getint "\n重设当前序号为:"))<br />     )<br />     ((= "" key)<br />      (princ "\n当前编号:")(princ n)<br />      (while (setq ss (ssget '((0 . "TEXT")(-4 . "< OR")(1 . "XL*")(1 . "KL*")(-4 . "OR >")) ))<br />        (setq ii 0)<br />        (repeat (sslength ss)<br />          (setq ent (ssname ss ii)<br />                  ii (1+ ii)<br />          )<br />          (chn)<br />        );end rep<br />        (princ "\n下一编号:")(princ  (1+ n))<br />        (setq n (1+ n))<br />      );end while<br />     )<br />    );end cond<br />   );end while<br /> (princ)<br /> )<br /> ;;(chn)<br /> (defun chn ( / entl e1 str1 i str2 i2 str3)<br />   (setq        entl (entget ent)<br />         e1   (cdr (assoc 1 entl))<br />         str1 (substr e1 1 2)<br />   )<br />      (if (= " " (substr e1 3 1))<br />        (setq i 3<br />              str1 (strcat str1 " ")<br />        )<br />        (setq i 2)<br />      )<br />      (setq str2        (substr e1 (1+ i))<br />            str2        (rtos (atoi str2) 2 0)<br />            i2        (strlen str2)<br />            str3        (substr e1 (+ i i2 1))<br />            e1        (strcat str1 (itoa n) str3)<br />            entl        (subst (cons 1 e1) (assoc 1 entl) entl)<br />      )<br />      (entmod entl)<br /> )            <br />   <br />   [/FONT]<br />

sparrow

怎么用呀？对图面条件有啥要求？有啥禁忌？

yoyoho

好程序值得学习
感谢班竹

qiuxiang129

收下～～