[LISP函数-点集]：获取点集中距离最远的两点集合

eachy · 发表于 2005-9-1 18:36:42

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;获取点集中距离最远的两点集合
;; 返回值 ((point11 point12) (point21 point22) ... )
(defun xd-GetFarthestPoints (ptl / ll p1 p2 d)
(setq ll
(vl-sort
(mapcar
'(lambda (x)
(car
(vl-sort
(mapcar '(lambda (p) (list (distance p x) x p)) ptl)
'(lambda (e1 e2)
(> (car e1) (car e2))
)
)
)
)
ptl
)
'(lambda (a b) (> (car a) (car b)))
)
)
(setq p1 (list (cdar ll))
d (caar ll)
ll (cdr ll)
)
(while (equal (car (setq p2 (car ll))) d 1e-5)
(if (and (not (vl-position (cdr p2) p1))
(not (vl-position (list (caddr p2) (cadr p2)) p1))
)
(setq p1 (append p1 (list (cdr p2))))
)
(setq ll (cdr ll))
)
(if (= (length p1) 1)
(car p1)
p1
)
)

;;获取点集中距离最远的两点集合 
;; 返回值 ((point11 point12) (point21 point22) ... ) 
(defun xd-GetFarthestPoints (ptl / ll p1 p2 d) 
  (setq        ll 
         (vl-sort 
           (mapcar 
             '(lambda (x) 
                (car 
                  (vl-sort 
                    (mapcar '(lambda (p) (list (distance p x) x p)) ptl) 
                    '(lambda (e1 e2) 
                       (> (car e1) (car e2)) 
                     ) 
                  ) 
                ) 
              ) 
             ptl 
           ) 
           '(lambda (a b) (> (car a) (car b))) 
         ) 
  ) 
  (setq        p1 (list (cdar ll)) 
        d  (caar ll) 
        ll (cdr ll) 
  ) 
  (while (equal (car (setq p2 (car ll))) d 1e-5) 
    (if        (and (not (vl-position (cdr p2) p1)) 
             (not (vl-position (list (caddr p2) (cadr p2)) p1)) 
        ) 
      (setq p1 (append p1 (list (cdr p2)))) 
    ) 
    (setq ll (cdr ll)) 
  ) 
  (if (= (length p1) 1) 
    (car p1) 
    p1 
  ) 
)

aeo · 发表于 2005-9-1 22:43:48

(defun Get$estPoints(pts / lst pt x y $temp)
(defun $temp(pt pts / x)
(mapcar '(lambda(x)(list(distance pt x) pt x)) pts)
)
(while (setq pt(car pts)
pts(cdr pts))
(setq lst(cons ($temp pt pts)lst))
)
(mapcar 'cdr
(vl-sort (apply 'append lst) '(lambda(x y)(>(car x)(car y))))
)
)

返回按距离排好序(大于)的俩俩点表.

雨箭风刀 · 发表于 2006-10-30 12:42:50

(defun mlenpts (ptlst / pt d maxd mind maxl minl)
(setq minl (list (car ptlst)(cadr ptlst)) maxd 0 mind (apply 'distance minl))
(while (setq pt (car ptlst) ptlst (cdr ptlst))
(foreach n ptlst
(setq d (distance n pt))
(cond ((< maxd d)(setq maxd d maxl (list n pt)))
((> mind d)(setq mind d minl (list n pt)))
)
)
)(list maxl minl)
)

账号		自动登录	找回密码
密码			立即注册

[LISP函数-点集]：获取点集中距离最远的两点集合

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子