表提重复

啵浪鼓

分析lst表中y坐标相同，保留一组移除其它y相同，该如何写函数?
((10 20) (5 40) (10 30) (20 40) (10 40))
因为y坐标40相同，返回
((10 20) (5 40) (10 30))

jun353835273

2. (defun RemoveY (lst /  y  result dict)  
   
3.   (setq result '())  
   
4.   (setq dict nil)  
   
5.   (foreach pt lst  
   
6.     (setq y (cadr pt))
   
7.     (if (not (assoc y dict))  
   
8.       (progn  
   
9.         (setq result (cons pt result))
   
10.         (setq dict (cons (cons y pt) dict))
    
11.       )  
    
12.     )  
    
13.   )  
    
14.   (reverse result)  
    
15. )

(defun RemoveY (lst /  y  result dict)  <br />   (setq result '())  <br />   (setq dict nil)  <br />   (foreach pt lst  <br />     (setq y (cadr pt)) <br />     (if (not (assoc y dict))  <br />       (progn  <br />         (setq result (cons pt result))<br />         (setq dict (cons (cons y pt) dict)) <br />       )  <br />     )  <br />   )  <br />   (reverse result)  <br /> )

dtucad

凑热闹，来个递归

1. (defun c:tt ()
   
2.         (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))
   
3.         (list-delsamey lst)
   
4. )
   
5. 
   
6. (defun list-delsamey (lst)
   
7.   (if Lst
   
8.                 (cons (car Lst) (list-delsamey (vl-remove-if '(lambda (x) (equal (cadar lst) (cadr x))) (cdr lst))))
   
9.         )
   
10. )

(defun c:tt ()<br />         (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))<br />         (list-delsamey lst)<br /> )<br /> <br /> (defun list-delsamey (lst)<br />   (if Lst <br />                 (cons (car Lst) (list-delsamey (vl-remove-if '(lambda (x) (equal (cadar lst) (cadr x))) (cdr lst))))<br />         )<br /> )

aws

2. (defun c:gg()
   
3.   (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))
   
4.   (setq newlst nil)
   
5.   (while
   
6.     (setq e(car lst))
   
7.     (setq newlst(cons e newlst))
   
8.     (setq lst(vl-remove-if '(lambda(x)(=(cadr x)(cadr e)))lst))
   
9.   )
   
10.   (setq newlst(reverse newlst))
    
11.   (princ newlst)
    
12.   (princ)
    
13. )

(defun c:gg()<br />   (setq lst '((10 20) (5 40) (10 30) (20 40) (10 40)))<br />   (setq newlst nil)<br />   (while<br />     (setq e(car lst))<br />     (setq newlst(cons e newlst))<br />     (setq lst(vl-remove-if '(lambda(x)(=(cadr x)(cadr e)))lst))<br />   )<br />   (setq newlst(reverse newlst))<br />   (princ newlst)<br />   (princ)<br /> )

MZ_li

大佬云集，收藏了

mahuan1279

一两句代码的事。

自贡黄明儒

1. (SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)))
   
2. (SETQ L (MAPCAR '(LAMBDA(X) (IF (MEMBER (CADR X) L) NIL(PROGN (SETQ L (CONS (CADR X) L)) X))) LL))
   
3. (VL-REMOVE NIL L)
   

(SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)))<br /> (SETQ L (MAPCAR '(LAMBDA(X) (IF (MEMBER (CADR X) L) NIL(PROGN (SETQ L (CONS (CADR X) L)) X))) LL))<br /> (VL-REMOVE NIL L)<br />

啵浪鼓

以上测试均OK，感谢╰(*︶`*)╯

lijiao

2. (SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)) l nil)
   
3. (VL-REMOVE-IF-not '(lambda(x) (if (not (member (cadr x) l)) (setq l (cons (cadr x) l)))) ll)

(SETQ LL '((10 20) (5 40) (10 30) (20 40) (10 40)) l nil)<br /> (VL-REMOVE-IF-not '(lambda(x) (if (not (member (cadr x) l)) (setq l (cons (cadr x) l)))) ll)

帝都划水王

666,好像有点用，之前也想编个类似的