[寻找]：有无精简的代码可以在一个坐标点表中找出距离最远或最近的两个点?

mmmm

有无精简的代码可以在一个坐标点表中找出距离最远或最近的两个点?

XDSoft

最初由 mmmm 发布
[B]有无精简的代码可以在一个坐标点表中找出距离最远或最近的两个点? [/B]

你据个例子吧，写一个点表，然后说明下要求什么？

另外“精简”的含义是什么？你写出来过，认为不精简吗？如果是，你把你的代码贴到论坛来吧。免得朋友给你写个和你一样算法的代码。

另外，请说明下是什么应用需要这样的函数？

blue

他的意思可能是说：如果要局部放大一个图形的某一部分，就需要找一个最小与最大的坐标值，也就是说，左下角与右上角的坐标点，然后用zoom—w时，输入左下角与右上角坐标，局部放大。

lsjjm

最初由 mmmm 发布
[B]有无精简的代码可以在一个坐标点表中找出距离最远或最近的两个点? [/B]

贴一个原始方法的程序, 不知是否"精简"?
[php]
(defun maxdispts (pts)
  (setq d0 0 n 0)
  (while (< n (length pts))
    (setq m 0)
    (while (< m (length pts))
      (setq d (distance (nth n pts)(nth m pts)))
      (if (and (/= d 0)(> d d0))
        (setq d0 d
              pl (list (nth n pts)(nth m pts)))
      )
      (setq m (1+ m))
    )
    (setq n (1+ n))
  )
  pl
)
[/php]

陌生人

[php]
;;测试程序--在屏幕取点后，画出最近/最远点的两条直线.
(defun c:test ( / pt ptlst)
  (setq opd (getvar "pdmode"))
  (setvar "pdmode" 3)
  (while (setq pt (getpoint "\n取点："))
    (vl-cmdf ".point" pt)(setq ptlst (cons pt ptlst))
  )
  (mapcar '(lambda (x)(vl-cmdf ".line" (car x)(cadr x) "")) (mlenpts ptlst));'
  (setvar "pdmode" opd)
  (princ)
)
;;按照距离排序取点程序，得（距离最小两点 距离最大两点）表;-------------------陌生人2004.3
(defun mlenpts (ptlst / mpts)
  (mapcar '(lambda (x)
             (mapcar '(lambda (y)
              (if (not(equal x y))
                  (setq mpts (cons (list (distance x y) x y) mpts))
                        mpts (vl-sort mpts '(lambda (a b) (< (car a)(car b))))
                        mpts (list (car mpts)(last mpts)))
              );end if
             )ptlst)
            )ptlst)
  (list (cdr (car mpts))(cdr (last mpts)))
)
[/php]
用foreach再改写
[program]
;;测试程序--在屏幕取点后，画出最近/最远点的两条直线.
(defun c:test ( / pt ptlst)
  (setq opd (getvar "pdmode"))
  (setvar "pdmode" 3)
  (while (setq pt (getpoint "\n取点："))
    (vl-cmdf ".point" pt)(setq ptlst (cons pt ptlst))
  )
  (mapcar '(lambda (x)(vl-cmdf ".line" (cadr x)(caddr x) "")) (mlenpts ptlst));'
  (setvar "pdmode" opd)
  (princ)
)
;;按照距离排序取点程序，得（(距离 最近两点) （距离 最远两点））表;-------------------ok! 陌生人.2004.3
(defun mlenpts (ptlst / mpts)
  (foreach x ptlst
    (foreach y ptlst
      (if (not(equal x y))
          (setq mpts (vl-sort (cons (list (distance x y) x y) mpts) '(lambda (a b) (< (car a)(car b))))
                mpts (list (car mpts)(last mpts)))
      )
    )
  )mpts
)
[/program]

aeo

[program]
用排序:  pts   pt
(vl-sort '(lambda(p1 p2)(<(distance pt p1)(distance pt p2)) )pts)  ；第一个，和最后一个.

不用排序：pts pt
(defun test(pts pt)
  (setq  ptmin(car pts)  ptmax ptmin
            dis1(distance pt ptmin) dis2 dis1)
(foreach p pts
    (setq dis(distance p pt) )
   (if(< dis dis1)(setq dis1 dis ptmin p))
   (if(> dis dis2)(setq dis2 dis ptmax p))
)
(list ptmin ptmax)
)

[/program]

陌生人

是“在坐标点表中找出距离最远或最近的两个点”（已知条件只有一个：点表）
不是“在坐标点表中找出距离指定点pt最远或最近的两个点”（已知条件2个：点表+pt点）

841594

陌生人：
我用你的程序改了一下。我猜测vl-sort函数的运行速度会比一般函数慢些，循环调用可能会影响速度的。

[php]
;;测试程序--在屏幕取点后，画出最近/最远点的两条直线.
(defun c:test ( / pt ptlst)
  (setq opd (getvar "pdmode"))
  (setvar "pdmode" 3)
  (while (setq pt (getpoint "\n取点："))
    (vl-cmdf ".point" pt)(setq ptlst (cons pt ptlst))
  )
  (mapcar '(lambda (x)(vl-cmdf ".line" (car x)(cadr x) "")) (mlenpts ptlst));'
  (setvar "pdmode" opd)
  (princ)
)

(defun mlenpts (ptlst / mpts pt1 pt2)
  (while (setq pt1 (car ptlst) ptlst (cdr ptlst))
    (foreach pt2 ptlst
      (setq mpts (cons (list (distance pt1 pt2) pt1 pt2) mpts))
    )
  )
  (setq mpts (vl-sort mpts '(lambda (a b) (< (car a)(car b)))))
  (list (cdr (car mpts)) (cdr (last mpts)))
)
[/php]

snsj

凑凑热闹
[php]
;;;|返回点表中距离最远的两点,PTS为点表
;;;|SNSJ 2004.4.8
(defun maxlst (pts / js i x tt jl ds)
(setq js 0 i 0)
(repeat (length pts)
(setq tt(nth i pts))
(mapcar '(lambda (x)
  (if(>(setq ds(distance tt x))js)
    (setq js ds jl (list x tt)))
             )pts
          )(setq i (1+ i))
             )jl
  )
[/php]

eachy

看到这个题目想到了那个求选择集交点程序[PHP]
;;求点集距离最大两点  eachy 2004.4.8
;;             晓东CAD家园
(defun max2pt (pts / n1 n2 pl dis dis1 p1 p2 ptl)
  (setq        n1  0
        pl  (length pts)
        dis 0.
  )
  (while (< n1 (1- pl))
    (setq p1 (nth n1 pts)
          n2 (1+ n1)
    )
    (while (< n2 pl)
      (setq p2 (nth n2 pts))
      (setq dis1 (distance p1 p2))
      (if (> dis1 dis)
        (setq ptl (list p1 p2))
      )
      (setq dis        dis1
            n2        (1+ n2)
      )
    )
    (setq n1 (1+ n1))
  )
  ptl
)[/PHP]

陌生人

841594那段你改的不错，鼓励一下：）

aeo

我看错了:)

eachy的好些: n *(n-1)(n-2)...次。

其它的是 n的n次方次.

陌生人

你还是看错了。841594改的也是，而且更巧妙
(while (setq pt1 (car ptlst) ptlst (cdr ptlst))
  （foreach。。。。
发一个纯lsp的，加入了841594和sn的部分代码

2. 
   
3. (defun mlenpts (ptlst / pt d maxd mind maxl minl)
   
4.   (setq minl (list (car ptlst)(cadr ptlst)) maxd 0 mind (apply 'distance minl))
   
5.   (while (setq pt (car ptlst) ptlst (cdr ptlst))
   
6.     (foreach n ptlst
   
7.       (setq d (distance n pt))
   
8.       (cond ((< maxd d)(setq maxd d maxl (list n pt)))
   
9.             ((> mind d)(setq mind d minl (list n pt)))
   
10.       )
    
11.     )
    
12.   )(list maxl minl)
    
13. )
    
14. ;;测试程序--在屏幕取点后，画出最近/最远点的两条直线.
    
15. (defun c:test ( / pt ptlst)
    
16.   (setq opd (getvar "pdmode"))
    
17.   (setvar "pdmode" 3)
    
18.   (while (setq pt (getpoint "\n取点："))
    
19.     (vl-cmdf ".point" pt)(setq ptlst (cons pt ptlst))
    
20.   )
    
21.   (mapcar '(lambda (x)(vl-cmdf ".line" (car x)(cadr x) "")) (mlenpts ptlst))
    
22.   (setvar "pdmode" opd)
    
23.   (princ)
    
24. )

<br /> (defun mlenpts (ptlst / pt d maxd mind maxl minl)<br />   (setq minl (list (car ptlst)(cadr ptlst)) maxd 0 mind (apply 'distance minl))<br />   (while (setq pt (car ptlst) ptlst (cdr ptlst))<br />     (foreach n ptlst<br />       (setq d (distance n pt))<br />       (cond ((< maxd d)(setq maxd d maxl (list n pt)))<br />             ((> mind d)(setq mind d minl (list n pt)))<br />       )<br />     )<br />   )(list maxl minl)<br /> )<br /> ;;测试程序--在屏幕取点后，画出最近/最远点的两条直线.<br /> (defun c:test ( / pt ptlst)<br />   (setq opd (getvar "pdmode"))<br />   (setvar "pdmode" 3)<br />   (while (setq pt (getpoint "\n取点："))<br />     (vl-cmdf ".point" pt)(setq ptlst (cons pt ptlst))<br />   )<br />   (mapcar '(lambda (x)(vl-cmdf ".line" (car x)(cadr x) "")) (mlenpts ptlst))<br />   (setvar "pdmode" opd)<br />   (princ)<br /> )

hnfsf

2. (defun &maxdis (lst / dis n p1 p2)
   
3.   (setq dis 0.0)
   
4.   (repeat (- (length lst) 1)
   
5.     (setq p1 (car lst) lst (cdr lst) n -1)
   
6.     (repeat (length lst)
   
7.       (setq p2 (nth (setq n (1+ n)) lst ))
   
8.       (if (and p1 p2 (> (distance p1 p2) dis))
   
9.         (setq dis (distance p1 p2))
   
10.       )
    
11.     )
    
12.   )
    
13.   dis
    
14. )

(defun &maxdis (lst / dis n p1 p2)<br />   (setq dis 0.0)<br />   (repeat (- (length lst) 1)<br />     (setq p1 (car lst) lst (cdr lst) n -1)<br />     (repeat (length lst)<br />       (setq p2 (nth (setq n (1+ n)) lst ))<br />       (if (and p1 p2 (> (distance p1 p2) dis))<br />         (setq dis (distance p1 p2))<br />       )<br />     )<br />   )<br />   dis<br /> )

taner

最初由 陌生人 发布
[B]你还是看错了。841594改的也是，而且更巧妙
(while (setq pt1 (car ptlst) ptlst (cdr ptlst))
  （foreach。。。。
发一个纯lsp的，加入了841594和sn的部分代码[code]
(defun mlenpts (ptlst / pt d maxd mind ... [/B]

如果点集正好组成一个矩形,则距离最小和最大的点各有两组.而程序只能求出一组.