【@lisp函数库】list:group-by 按给定特征对表内元素分组。

vital

用法:

1. (list:group-by lst 'fun)

(list:group-by lst 'fun)

示例：
比如一组整数 lst = ( 1 3 5 1 4 5 3 8 2)
(setq lst '(1 3 5 1 4 5 3 8 2))
因为内部有相同的元素，我们无法使用 vl-sort 排序。所以使用 list:sort 进行无损排序
(setq lst (list:sort lst '<))
然后把相同的元素进行分组
(setq res (list:group-by lst '=))






比较函数 fun 的说明示例。
对于一个图元表 lst， 内容为 (ent1 ent2 ent3 ent4 ....entn)
如果我们要对它按特定特征分组。需要分两步进行。
1、按特征进行排序，比如 都是 单行文本 text 按 内容排序。
(setq lst (vl-sort lst '(lambda(x y) (< (entity:getdxf x 1)(entity:getdxf y 1)))))
2、按特征分组,fun 的意思是特征相同返回真，则分为一组。
(setq lst (list:group-by lst '(lambda(x y) (= (entity:getdxf x 1)(entity:getdxf y 1)))))

1. (defun list:group-by (lst fun / res g)
   
2.   "对已排序的列表lst进行分组。fun为分组依据"
   
3.   "lst"
   
4.   "(list:group-by '(a a a b b c)
   
5.     '(lambda(x y)(= x y)))
   
6.   => ((a a a)(b b)(c))"
   
7.   (setq res nil)
   
8.   (setq g (cons (car lst)
   
9.       nil))
   
10.   (while (setq lst (cdr lst))
    
11.     (setq a% (car lst))
    
12.     (if ((eval fun)
    
13.         (car g)
    
14.         a%)
    
15.       (setq g (cons a% g))
    
16.       (progn (setq res (cons (reverse g)
    
17.             res))
    
18.         (setq g (cons a% nil)))))
    
19.   (if g (setq res (cons (reverse g)
    
20.         res)))
    
21.   (reverse res))

(defun list:group-by (lst fun / res g)<br />   "对已排序的列表lst进行分组。fun为分组依据"<br />   "lst"<br />   "(list:group-by '(a a a b b c)<br />     '(lambda(x y)(= x y)))<br />   => ((a a a)(b b)(c))"<br />   (setq res nil)<br />   (setq g (cons (car lst)<br />       nil))<br />   (while (setq lst (cdr lst))<br />     (setq a% (car lst))<br />     (if ((eval fun)<br />         (car g)<br />         a%)<br />       (setq g (cons a% g))<br />       (progn (setq res (cons (reverse g)<br />             res))<br />         (setq g (cons a% nil)))))<br />   (if g (setq res (cons (reverse g)<br />         res)))<br />   (reverse res))

无须复制，在CAD内 安装 @lisp ,可以直接调用这个函数。

将以下代码复制到 CAD 命令行内，回车即可开始安装。
(在代码行里用鼠标连续三击全选，然后右键复制或Ctrl+C 。到CAD命令行内,右键粘贴或Ctrl+V)

1. (progn(vl-load-com)(setq s strcat h "http" o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://atlisp.""org/@"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))

(progn(vl-load-com)(setq s strcat h "http" o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://atlisp.""org/@"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))

关注 公众号，快速查看 @lisp 函数用法