相同项分组
本帖最后由 dcl1214 于 2024-8-19 13:28 编辑多个列表中快速分组，您可以拿来快速查找直线顺延，也可以快速分组；如果您有更快的分组方法，可以分享出来一起学习
(defun $根据相同项分组$
(dld-xhs/ i JILU s
XUNHUANgroup dld-data tzdata IS
delsame
)
(defun delsame (lst / s-car new)
;删除表中重复项，删除重复
(setq lst (vl-remove nil lst))
(while (setq s-car (car lst))
(if (vl-position s-car new)
()
(set 'new (cons s-car new))
)
(setq lst (cdr lst))
)
(setq new (reverse new))
new
)
(if (and dld-xhs (= (type dld-xhs) 'list))
(progn
(setq dld-xhs (delsame dld-xhs)) ;排重一下
(while (setq IS (car dld-xhs)) ;开始读取第一组
(setq JILU nil) ;变量做空
(SETQ XUNHUAN IS) ;下面需要循环的数据赋值给xunhuan
(SETQ JILU (LIST IS)) ;将第一组数据添加到jilu
(while (setq i (car XUNHUAN)) ;开始读取xunhuan的第一个数据
(SETQ S NIL) ;做空变量
(setq s (vl-some (function (lambda (b)
(if (member i b)
B
)
)
)
(cdr dld-xhs)
) ;找到与包含I的数据，返回这一组找到的数据，意思是包含I的数据
)
(if s
(PROGN
(setq dld-xhs (vl-remove S dld-xhs))
;重置dld-xhs的数据，主要是给while提速的
(setq JILU (vl-remove nil (cons s JILU)))
;将找到的这一组数据S添加到jilu
)
)
(setq XUNHUAN (CDR XUNHUAN)) ;重置xunhuan，意思是将第一个数据删除，只留下cdr后面的数据
(setq XUNHUAN (vl-remove nil (append XUNHUAN s)))
;将找到的s添加到xunhuan里面去，让while继续找
)
(if JILU
(progn (setq JILU (reverse JILU))
(setq group (cons JILU group))
)
) ;xunhuan变量的所有关联的数据都找到了，此时结果添加到group里面
(setq dld-xhs (cdr dld-xhs)) ;重置dld-xhs的数据，意思是删除第一个，保留cdr后面的数据
)
(setq group (reverse group)) ;倒置
)
)
group
)
;;;;;;;以下测试代码
(defun c:tt (/ a ents gs i pts ss)
(AND (setq ss (ssget (list (cons 0 "LINE"))))
(SETQ ENTS (vl-remove-if
(function listp)
(mapcar (function cadr) (ssnamex SS))
)
)
(setq ss nil)
)
(setq pts
(MAPCAR (FUNCTION (LAMBDA (A)
(SETQ DXF (ENTGET A))
(LIST (CDR (ASSOC 5 DXF))
(CDR (ASSOC 10 DXF))
(CDR (ASSOC 11 DXF))
)
)
)
ENTS
)
)
(SETQ GS ($根据相同项分组$ pts))
(SETQ i 1)
(WHILE (SETQ A (CAR GS))
(if (>= i 250)
(setq i 1)
)
(setq ents (mapcar 'handent (mapcar 'car a)))
(mapcar (function (lambda (b / obj)
(setq obj (vlax-ename->vla-object b))
(vla-put-color obj i)
)
)
ents
)
(setq i (1+ i))
(SETQ GS (CDR GS))
)
)
;示例
(setq d($根据相同项分组$(list(list 1 2 3 4)(list 2 5 6 7 8)(list 5 9 10 11)(list 99 0 18))))
;返回
(((1 2 3 4) (2 5 6 7 8) (5 9 10 11))
((99 0 18)))
学习.没有看明白相同项特征.用来干什么的. 纯数学算法，看起来没有太大用 快速查找直线顺延 请问杜总你这个直线顺延 具体是指的啥呢？能否具体解释下 谢谢！ 另外杜总 你这个代码 将列表由小到大排序以后再分组速度又可以提升一些不妨测试下 (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)
) 新人学习了 kkq0305 发表于 2022-11-5 21:23
(defun tt (lst / group is bs as a n)
(setq group nil)
(while lst
5万条数据，循环多久？ dcl1214 发表于 2022-11-5 23:12
5万条数据，循环多久？
经测试数据量大的时候 比如超过1万个列表时 杜总的代码要快很多 本帖最后由 guosheyang 于 2022-11-6 13:44 编辑
这个分组代码可以用于分堆相连图元的坐标分堆提取 用于分堆链式选择也可直线顺延大概就是指的这个
页:
[1]
2