lisp爱好者 发表于 2014-4-13 22:43:48

求助坐标点表筛选

快大半年没上明经了，很久没写程序了，一下子找不着北了，脑子里一片空白......
求助各位下，关于点表筛选，如有下列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 发表于 2014-4-13 22:50:09

试试vl-member-if。

重慶崽兒 发表于 2014-4-13 23:26:17

额....我的方法比较笨，大大看看就成，献丑了！
(defun c:tt()
(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))
(setq i 0)
(setq xinbiao nil)
(repeat (length lst)
    (setq X (car (nth i lst)))
    (if (> X (car pt))
      (setq xinbiao (append xinbiao (list (nth i lst))))
    )
    (setq i (1+ i))
)
(print xinbiao)
(princ)
)

lisp爱好者 发表于 2014-4-13 23:42:44

ll_j 发表于 2014-4-13 22:50 static/image/common/back.gif
试试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 发表于 2014-4-14 00:03:50

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

lisp爱好者 发表于 2014-4-14 17:20:48

xyp1964 发表于 2014-4-14 00:03 static/image/common/back.gif
(vl-remove-if '(lambda (x) (
院长的代码好使，10分感谢！
另外请教个问题，怎么去除筛选后同y的坐标，只保留一个。也就是说这个新lst中有相同y坐标的，取其一即可，还望赐教，谢谢

lisp爱好者 发表于 2014-4-14 17:22:17

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

谢谢支持，方法不错

lisp爱好者 发表于 2014-4-14 17:28:15

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

xyp1964 发表于 2014-4-14 19:58:06

本帖最后由 xyp1964 于 2014-4-14 19:59 编辑

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

llsheng_73 发表于 2014-4-15 10:59:12

(defun tt(lst / a b)
(while lst
(setq a(car lst)lst(cdr lst)
a(car(vl-sort(cons a(vl-remove-if'(lambda(x)(/=(cadr a)(cadr x)))lst))(function(lambda(x1 x2)(>(car x1)(car x2))))))
lst(vl-remove-if'(lambda(x)(=(cadr a)(cadr x)))lst))
(setq b(cons a b)))
(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))
页: [1] 2
查看完整版本: 求助坐标点表筛选