相同项分组

dcl1214

多个列表中快速分组，您可以拿来快速查找直线顺延，也可以快速分组；如果您有更快的分组方法，可以分享出来一起学习

1. (defun $根据相同项分组$
   
2.                         (dld-xhs  /           i            JILU     s
   
3.                          XUNHUAN  group           dld-data tzdata   IS
   
4.                          delsame
   
5.                         )
   
6.   (defun delsame (lst / s-car new)
   
7.                                         ;删除表中重复项，删除重复
   
8.     (setq lst (vl-remove nil lst))
   
9.     (while (setq s-car (car lst))
   
10.       (if (vl-position s-car new)
    
11.         ()
    
12.         (set 'new (cons s-car new))
    
13.       )
    
14.       (setq lst (cdr lst))
    
15.     )
    
16.     (setq new (reverse new))
    
17.     new
    
18.   )
    
19.   (if (and dld-xhs (= (type dld-xhs) 'list))
    
20.     (progn
    
21.       (setq dld-xhs (delsame dld-xhs))        ;排重一下
    
22.       (while (setq IS (car dld-xhs))        ;开始读取第一组
    
23.         (setq JILU nil)                        ;变量做空
    
24.         (SETQ XUNHUAN IS)                ;下面需要循环的数据赋值给xunhuan
    
25.         (SETQ JILU (LIST IS))                ;将第一组数据添加到jilu
    
26.         (while (setq i (car XUNHUAN))        ;开始读取xunhuan的第一个数据
    
27.           (SETQ S NIL)                        ;做空变量
    
28.           (setq        s (vl-some (function (lambda (b)
    
29.                                        (if (member i b)
    
30.                                          B
    
31.                                        )
    
32.                                      )
    
33.                            )
    
34.                            (cdr dld-xhs)
    
35.                   )                        ;找到与包含I的数据，返回这一组找到的数据，意思是包含I的数据
    
36.           )
    
37.           (if s
    
38.             (PROGN
    
39.               (setq dld-xhs (vl-remove S dld-xhs))
    
40.                                         ;重置dld-xhs的数据，主要是给while提速的
    
41.               (setq JILU (vl-remove nil (cons s JILU)))
    
42.                                         ;将找到的这一组数据S添加到jilu
    
43.             )
    
44.           )
    
45.           (setq XUNHUAN (CDR XUNHUAN))        ;重置xunhuan，意思是将第一个数据删除，只留下cdr后面的数据
    
46.           (setq XUNHUAN (vl-remove nil (append XUNHUAN s)))
    
47.                                         ;将找到的s添加到xunhuan里面去，让while继续找
    
48.         )
    
49.         (if JILU
    
50.           (progn (setq JILU (reverse JILU))
    
51.                  (setq group (cons JILU group))
    
52.           )
    
53.         )                                ;xunhuan变量的所有关联的数据都找到了，此时结果添加到group里面
    
54.         (setq dld-xhs (cdr dld-xhs))        ;重置dld-xhs的数据，意思是删除第一个，保留cdr后面的数据
    
55.       )
    
56.       (setq group (reverse group))        ;倒置
    
57.     )
    
58.   )
    
59.   group
    
60. )
    
61. 
    
62. 
    
63. 
    
64. ;;;;;;;以下测试代码
    
65. (defun c:tt (/ a ents gs i pts ss)
    
66.   (AND (setq ss (ssget (list (cons 0 "LINE"))))
    
67.        (SETQ ENTS (vl-remove-if
    
68.                     (function listp)
    
69.                     (mapcar (function cadr) (ssnamex SS))
    
70.                   )
    
71.        )
    
72.        (setq ss nil)
    
73.   )
    
74.   (setq        pts
    
75.          (MAPCAR (FUNCTION (LAMBDA (A)
    
76.                              (SETQ DXF (ENTGET A))
    
77.                              (LIST (CDR (ASSOC 5 DXF))
    
78.                                    (CDR (ASSOC 10 DXF))
    
79.                                    (CDR (ASSOC 11 DXF))
    
80.                              )
    
81.                            )
    
82.                  )
    
83.                  ENTS
    
84.          )
    
85.   )
    
86.   (SETQ GS ($根据相同项分组$ pts))
    
87.   (SETQ i 1)
    
88.   (WHILE (SETQ A (CAR GS))
    
89.     (if        (>= i 250)
    
90.       (setq i 1)
    
91.     )
    
92.     (setq ents (mapcar 'handent (mapcar 'car a)))
    
93.     (mapcar (function (lambda (b / obj)
    
94.                         (setq obj (vlax-ename->vla-object b))
    
95.                         (vla-put-color obj i)
    
96.                       )
    
97.             )
    
98.             ents
    
99.     )
    
100.     (setq i (1+ i))
     
101.     (SETQ GS (CDR GS))
     
102.   )
     
103. )
     

(defun $根据相同项分组$<br />                         (dld-xhs  /           i            JILU     s<br />                          XUNHUAN  group           dld-data tzdata   IS<br />                          delsame<br />                         )<br />   (defun delsame (lst / s-car new)<br />                                         ;删除表中重复项，删除重复<br />     (setq lst (vl-remove nil lst))<br />     (while (setq s-car (car lst))<br />       (if (vl-position s-car new)<br />         ()<br />         (set 'new (cons s-car new))<br />       )<br />       (setq lst (cdr lst))<br />     )<br />     (setq new (reverse new))<br />     new<br />   )<br />   (if (and dld-xhs (= (type dld-xhs) 'list))<br />     (progn<br />       (setq dld-xhs (delsame dld-xhs))        ;排重一下<br />       (while (setq IS (car dld-xhs))        ;开始读取第一组<br />         (setq JILU nil)                        ;变量做空<br />         (SETQ XUNHUAN IS)                ;下面需要循环的数据赋值给xunhuan<br />         (SETQ JILU (LIST IS))                ;将第一组数据添加到jilu<br />         (while (setq i (car XUNHUAN))        ;开始读取xunhuan的第一个数据<br />           (SETQ S NIL)                        ;做空变量<br />           (setq        s (vl-some (function (lambda (b)<br />                                        (if (member i b)<br />                                          B<br />                                        )<br />                                      )<br />                            )<br />                            (cdr dld-xhs)<br />                   )                        ;找到与包含I的数据，返回这一组找到的数据，意思是包含I的数据<br />           )<br />           (if s<br />             (PROGN<br />               (setq dld-xhs (vl-remove S dld-xhs))<br />                                         ;重置dld-xhs的数据，主要是给while提速的<br />               (setq JILU (vl-remove nil (cons s JILU)))<br />                                         ;将找到的这一组数据S添加到jilu<br />             )<br />           )<br />           (setq XUNHUAN (CDR XUNHUAN))        ;重置xunhuan，意思是将第一个数据删除，只留下cdr后面的数据<br />           (setq XUNHUAN (vl-remove nil (append XUNHUAN s)))<br />                                         ;将找到的s添加到xunhuan里面去，让while继续找<br />         )<br />         (if JILU<br />           (progn (setq JILU (reverse JILU))<br />                  (setq group (cons JILU group))<br />           )<br />         )                                ;xunhuan变量的所有关联的数据都找到了，此时结果添加到group里面<br />         (setq dld-xhs (cdr dld-xhs))        ;重置dld-xhs的数据，意思是删除第一个，保留cdr后面的数据<br />       )<br />       (setq group (reverse group))        ;倒置<br />     )<br />   )<br />   group<br /> )<br /> <br /> <br /> <br /> ;;;;;;;以下测试代码<br /> (defun c:tt (/ a ents gs i pts ss)<br />   (AND (setq ss (ssget (list (cons 0 "LINE"))))<br />        (SETQ ENTS (vl-remove-if<br />                     (function listp)<br />                     (mapcar (function cadr) (ssnamex SS))<br />                   )<br />        )<br />        (setq ss nil)<br />   )<br />   (setq        pts<br />          (MAPCAR (FUNCTION (LAMBDA (A)<br />                              (SETQ DXF (ENTGET A))<br />                              (LIST (CDR (ASSOC 5 DXF))<br />                                    (CDR (ASSOC 10 DXF))<br />                                    (CDR (ASSOC 11 DXF))<br />                              )<br />                            )<br />                  )<br />                  ENTS<br />          )<br />   )<br />   (SETQ GS ($根据相同项分组$ pts))<br />   (SETQ i 1)<br />   (WHILE (SETQ A (CAR GS))<br />     (if        (>= i 250)<br />       (setq i 1)<br />     )<br />     (setq ents (mapcar 'handent (mapcar 'car a)))<br />     (mapcar (function (lambda (b / obj)<br />                         (setq obj (vlax-ename->vla-object b))<br />                         (vla-put-color obj i)<br />                       )<br />             )<br />             ents<br />     )<br />     (setq i (1+ i))<br />     (SETQ GS (CDR GS))<br />   )<br /> )<br />

2. ;示例
   
3. (setq d($根据相同项分组$(list(list 1 2 3 4)(list 2 5 6 7 8)(list 5 9 10 11)(list 99 0 18))))
   
4. ;返回
   
5. (((1 2 3 4) (2 5 6 7 8) (5 9 10 11))
   
6. ((99 0 18)))

;示例<br /> (setq d($根据相同项分组$(list(list 1 2 3 4)(list 2 5 6 7 8)(list 5 9 10 11)(list 99 0 18))))<br /> ;返回<br /> (((1 2 3 4) (2 5 6 7 8) (5 9 10 11)) <br /> ((99 0 18)))

黄翔

学习.没有看明白相同项特征.用来干什么的.

ytianxia

纯数学算法，看起来没有太大用

guosheyang

快速查找直线顺延    请问杜总  你这个直线顺延 具体是指的啥呢？能否具体解释下   谢谢！

guosheyang

另外  杜总 你这个代码   将列表由小到大排序以后  再分组  速度又可以提升一些  不妨测试下

kkq0305

(defun tt (lst / group is bs as a n)
  (setq group nil)
  (while lst
    (setq is  (car lst)
          lst (cdr lst)
          bs  (list is)
    )
    (while (setq a (car is))
      (if (setq as (vl-remove-if-not '(lambda (x) (member a x)) lst))
        (foreach n as
          (setq        bs  (cons n bs)
                is  (append is n)
                lst (vl-remove n lst)
          )
        )
      )
      (setq is (vl-remove a is))
    )
    (setq group (cons (reverse bs) group))
  )
  (reverse group)
)

myhomer

新人学习了

dcl1214

kkq0305 发表于 2022-11-5 21:23
(defun tt (lst / group is bs as a n)
  (setq group nil)
  (while lst

5万条数据，循环多久？

guosheyang

dcl1214 发表于 2022-11-5 23:12
5万条数据，循环多久？

经测试数据量大的时候 比如超过1万个列表时   杜总的代码要快很多

guosheyang

这个分组代码可以用于分堆相连图元的坐标分堆提取   用于分堆链式选择也可  直线顺延大概就是指的这个