刘志军的pkpm钢筋号重排序

cy956

这是刘志军写的一段程序，我帮他改了一下。
程序中的选择集过滤没写全，－－
我也不知道pkpm中用的是什么图层，
使用者可以自己加上。
如果用r2k以上，可以用vl－sort来排序。

2. 
   
3. (defun lup (a / b mn mx)
   
4. ;;;对一个数字表排序，重复的忽略
   
5.   (setq mn (apply 'min a)
   
6.         mn (- mn 1000.)
   
7.   )
   
8.   (while (> (setq mx (apply 'max a)) mn)
   
9.     (setq b (cons mx b)
   
10.           a (subst mn mx a)
    
11.     )
    
12.   )
    
13.   b
    
14. )
    
15. (defun cy_ssgetp(@p @wc @d @filt / s);;SSGETP @WC="W,C" @D=范围
    
16.   (if (not @d)(setq @d 0))
    
17.   (if @filt
    
18.     (if @d
    
19.       (setq s(ssget @wc (xd @p @d @d) (xd @p (- @d) (- @d)) @filt))
    
20.       (setq s(ssget "p" @p @filt)))
    
21.     (if @d
    
22.       (setq s(ssget @wc (xd @p @d @d) (xd @p (- @d) (- @d))))
    
23.       (setq s(ssget "p" @p)))
    
24.   )s
    
25. )
    
26. (defun pri (a b c / x)
    
27.   (princ (strcat b " <"))(princ c)(setq x (a ">:"))
    
28.   (if (and x (/= x "")) x c)
    
29. )
    
30. (defun dxf (#code #list)(cdr (assoc #code #list)))
    
31. ;;;===================================================================================
    
32. (defun c:txtpx (/ CEN E E1 EN EN1 GETINT IN IN1 N N0 PB1 PB2 R S S1 T1 TXT0)
    
33. ;;;;数字序列号重新排序
    
34.   (setq txt0 (pri getint "\n输入起始数字:" 1))
    
35.   (prompt "\n选择支座钢筋圆圈，对钢筋号统一排序:")
    
36.   (setq s (ssget '((0 . "CIRCLE")));;(8 . "支座钢筋标注")))
    
37.         in 0 n (sslength s)
    
38.         pb1 '() pb2 '())
    
39.   (repeat n
    
40.     (setq e  (ssname s in)in   (1+ in)
    
41.           en  (entget e) cen(dxf 10 en)
    
42.           r(dxf 40 en)
    
43.           s1(cy_ssgetp cen "c" r '((0 . "TEXT"))));;;加图层
    
44.     (if s1
    
45.       (setq e1(ssname s1 0)en1(entget e1)
    
46.             t1(dxf 1 en1)
    
47.             pb1(append pb1 (list (distof t1)))
    
48.             pb2(append pb2 (list(list (distof t1) en1))))
    
49.     )
    
50.   )
    
51.   (setq pb1 (lup pb1)
    
52.         n0  (length pb1)
    
53.   )
    
54.   (foreach x pb2
    
55.     (setq in  (car x)en  (cadr x)
    
56.           n   (length (member in pb1))
    
57.           in1 (rtos (+ txt0 (- n0 n)) 2 0)
    
58.           en  (subst (cons 1 in1) (assoc 1 en) en)
    
59.     )
    
60.     (entmod en)
    
61.   )(princ)
    
62. )
    

<br /> (defun lup (a / b mn mx)<br /> ;;;对一个数字表排序，重复的忽略<br />   (setq mn (apply 'min a)<br />         mn (- mn 1000.)<br />   )<br />   (while (> (setq mx (apply 'max a)) mn)<br />     (setq b (cons mx b)<br />           a (subst mn mx a)<br />     )<br />   )<br />   b<br /> )<br /> (defun cy_ssgetp(@p @wc @d @filt / s);;SSGETP @WC="W,C" @D=范围<br />   (if (not @d)(setq @d 0))<br />   (if @filt<br />     (if @d<br />       (setq s(ssget @wc (xd @p @d @d) (xd @p (- @d) (- @d)) @filt))<br />       (setq s(ssget "p" @p @filt)))<br />     (if @d<br />       (setq s(ssget @wc (xd @p @d @d) (xd @p (- @d) (- @d))))<br />       (setq s(ssget "p" @p)))<br />   )s<br /> )<br /> (defun pri (a b c / x)<br />   (princ (strcat b " <"))(princ c)(setq x (a ">:"))<br />   (if (and x (/= x "")) x c) <br /> )<br /> (defun dxf (#code #list)(cdr (assoc #code #list)))<br /> ;;;===================================================================================<br /> (defun c:txtpx (/ CEN E E1 EN EN1 GETINT IN IN1 N N0 PB1 PB2 R S S1 T1 TXT0)<br /> ;;;;数字序列号重新排序<br />   (setq txt0 (pri getint "\n输入起始数字:" 1))<br />   (prompt "\n选择支座钢筋圆圈，对钢筋号统一排序:")<br />   (setq s (ssget '((0 . "CIRCLE")));;(8 . "支座钢筋标注")))<br />         in 0 n (sslength s)<br />         pb1 '() pb2 '())<br />   (repeat n<br />     (setq e  (ssname s in)in   (1+ in)<br />           en  (entget e) cen(dxf 10 en)<br />           r(dxf 40 en)<br />           s1(cy_ssgetp cen "c" r '((0 . "TEXT"))));;;加图层<br />     (if s1<br />       (setq e1(ssname s1 0)en1(entget e1)<br />             t1(dxf 1 en1)<br />             pb1(append pb1 (list (distof t1)))<br />             pb2(append pb2 (list(list (distof t1) en1))))<br />     )<br />   )<br />   (setq pb1 (lup pb1)<br />         n0  (length pb1)<br />   )<br />   (foreach x pb2<br />     (setq in  (car x)en  (cadr x)<br />           n   (length (member in pb1))<br />           in1 (rtos (+ txt0 (- n0 n)) 2 0)<br />           en  (subst (cons 1 in1) (assoc 1 en) en)<br />     )<br />     (entmod en)<br />   )(princ)<br /> )<br />