求助坐标点表筛选

lisp爱好者

快大半年没上明经了，很久没写程序了，一下子找不着北了，脑子里一片空白......
求助各位下，关于点表筛选，如有下列lst长表和pt点：
(setq lst '((551.412 853.27) (551.412 640.288) (698.483 636.515) (702.702 700.806) (742.78 704.67) (742.725 735.776) (815.147 735.776) (815.147 817.797) (615.585 848.354)))
(setq pt '(683.279 744.893 0.0))
请问如果从lst点表中筛选出x方向大于pt点x方向的点表，组成新表，一下子卡壳了...

ll_j

试试vl-member-if。

重慶崽兒

额....我的方法比较笨，大大看看就成，献丑了！

1. (defun c:tt()
   
2.   (setq lst '((551.412 853.27) (551.412 640.288) (698.483 636.515) (702.702 700.806) (742.78 704.67) (742.725 735.776) (815.147 735.776) (815.147 817.797) (615.585 848.354)))
   
3.   (setq pt '(683.279 744.893 0.0))
   
4.   (setq i 0)
   
5.   (setq xinbiao nil)
   
6.   (repeat (length lst)
   
7.     (setq X (car (nth i lst)))
   
8.     (if (> X (car pt))
   
9.       (setq xinbiao (append xinbiao (list (nth i lst))))
   
10.     )
    
11.     (setq i (1+ i))
    
12.   )
    
13.   (print xinbiao)
    
14.   (princ)
    
15. )

(defun c:tt()<br />   (setq lst '((551.412 853.27) (551.412 640.288) (698.483 636.515) (702.702 700.806) (742.78 704.67) (742.725 735.776) (815.147 735.776) (815.147 817.797) (615.585 848.354)))<br />   (setq pt '(683.279 744.893 0.0))<br />   (setq i 0)<br />   (setq xinbiao nil)<br />   (repeat (length lst)<br />     (setq X (car (nth i lst)))<br />     (if (> X (car pt))<br />       (setq xinbiao (append xinbiao (list (nth i lst))))<br />     )<br />     (setq i (1+ i))<br />   )<br />   (print xinbiao)<br />   (princ)<br /> )

lisp爱好者

ll_j 发表于 2014-4-13 22:50
试试vl-member-if。

谢谢，很少用vl函数，基础不好，大师能否指点下
我现在用的笨方法：
        (setq pc (car pt) lsa '())
        (while lst
          (if (< pc (caar lst))
            (setq lsa (cons (car lst) lsa))
          )
          (setq lst (cdr lst))
        )

xyp1964

(vl-remove-if '(lambda (x) (<= (car x) (car pt))) lst)

lisp爱好者

xyp1964 发表于 2014-4-14 00:03
(vl-remove-if '(lambda (x) (

院长的代码好使，10分感谢！
另外请教个问题，怎么去除筛选后同y的坐标，只保留一个。也就是说这个新lst中有相同y坐标的，取其一即可，还望赐教，谢谢

lisp爱好者

重慶崽兒 发表于 2014-4-13 23:26
额....我的方法比较笨，大大看看就成，献丑了！

谢谢支持，方法不错

lisp爱好者

应该是如果有两个或两个以上相同y方向的坐标（x方向不一样）怎么保留其中之一，x方向大则保留，谢谢

xyp1964

2. ;; (aaa lst pt)
   
3. (defun aaa (lst pt / lst1 ptn)
   
4.   (setq lst  (vl-remove-if '(lambda (x) (<= (car x) (car pt))) lst)
   
5.         lst (vl-sort lst '(lambda (x y)
   
6.                          (cond ((< (cadr x) (cadr y)) T)
   
7.                                ((and (= (cadr x) (cadr y))(> (car x) (car y)))T)
   
8.                                (T nil)
   
9.                          )
   
10.                        )
    
11.              )
    
12.         lst1 '()
    
13.         ptn  '()
    
14.   )
    
15.   (foreach pt lst
    
16.     (if (not (member (cadr pt) lst1))
    
17.       (setq lst1 (cons (cadr pt) lst1)
    
18.             ptn (cons pt ptn)
    
19.       )
    
20.     )
    
21.   )
    
22.   (reverse ptn)
    
23. )

;; (aaa lst pt)<br /> (defun aaa (lst pt / lst1 ptn)<br />   (setq lst  (vl-remove-if '(lambda (x) (<= (car x) (car pt))) lst)<br />         lst (vl-sort lst '(lambda (x y)<br />                          (cond ((< (cadr x) (cadr y)) T)<br />                                ((and (= (cadr x) (cadr y))(> (car x) (car y)))T)<br />                                (T nil)<br />                          )<br />                        )<br />              )<br />         lst1 '()<br />         ptn  '()<br />   )<br />   (foreach pt lst<br />     (if (not (member (cadr pt) lst1))<br />       (setq lst1 (cons (cadr pt) lst1)<br />             ptn (cons pt ptn)<br />       )<br />     )<br />   )<br />   (reverse ptn)<br /> )

llsheng_73

1. (defun tt(lst / a b)
   
2.   (while lst
   
3.   (setq a(car lst)lst(cdr lst)
   
4. a(car(vl-sort(cons a(vl-remove-if'(lambda(x)(/=(cadr a)(cadr x)))lst))(function(lambda(x1 x2)(>(car x1)(car x2))))))
   
5. lst(vl-remove-if'(lambda(x)(=(cadr a)(cadr x)))lst))
   
6.   (setq b(cons a b)))
   
7. (reverse b))

(defun tt(lst / a b)<br />   (while lst<br />   (setq a(car lst)lst(cdr lst)<br /> a(car(vl-sort(cons a(vl-remove-if'(lambda(x)(/=(cadr a)(cadr x)))lst))(function(lambda(x1 x2)(>(car x1)(car x2))))))<br /> lst(vl-remove-if'(lambda(x)(=(cadr a)(cadr x)))lst))<br />   (setq b(cons a b)))<br /> (reverse b))

;;;;_$(tt'((551.412 853.27)(688.70 700.806)(702.702 700.806)(742.78 704.67)(768.78 704.67)(615.585 848.354)))
;;;;((551.412 853.27) (702.702 700.806) (768.78 704.67) (615.585 848.354))