[求助]：如何对点表进行排序

xyzjint_cn

我有一点表，是一个矩形的四个顶点的表，PLIST(（x1 ,y1)(x2,y2)(x3,y3)(x4,y4))

现要对PLIST按（左下角，右上角，左上角，右下角）进行排序，自己编了一个，总是出错，有时将所有的X坐标设置为同一个值，有时将所有的Y坐标设为同一个，有时竟将一个X坐标赋给了Y坐标，

请各位指教。用AUTOLISP进行编程

XDSoft

最初由 xyzjint_cn 发布
[B]我有一点表，是一个矩形的四个顶点的表，PLIST(（x1 ,y1)(x2,y2)(x3,y3)(x4,y4))

现要对PLIST按（左下角，右上角，左上角，右下角）进行排序，自己编了一个，总是出错，有时将所有的X坐标设置为同一个值，有时将?.. [/B]

把你的程序贴上来吧，让大家帮你分析分析。

lijiao

help

aeo

就四个点呀:
(setq x (mapcar 'car PLIST) y (mapcar 'cadr PLIST))
(setq minx(apply 'min x) maxx(apply 'max x)
         miny(apply 'min y) maxy(apply 'max y) )
下面自己组合一下.

lsjjm

试试这个：
(defun test (pp)
  (setq pp (vl-sort pp '(lambda (x1 x2) (< (car x1)(car x2)))))
  (setq p14 (vl-sort (list (car pp)(cadr pp)) '(lambda (x1 x2) (< (cadr x1)(cadr x2)))))
  (setq p23 (vl-sort (list (caddr pp)(last pp)) '(lambda (x1 x2) (> (cadr x1)(cadr x2)))))
  (list (car p14)(car p23)(cadr p14)(cadr p23))
)

陌生人

(setq xs (vl-sort (mapcar 'car ptlst) '<)
      ys (vl-sort (mapcar 'cadr ptlst) '<))
(list (list(car xs)(car ys)) (list (car xs)(cadr ys))(list (cadr xs)(cadr ys))(list (cadr xs)(car ys)))

aeo

我看别人在问r14怎么办,
又不会写排序.

cy956

最初由 aeo 发布
[B]我看别人在问r14怎么办,
又不会写排序. [/B]

2. 
   
3. 老lisp版的
   
4. (defun #px-point1(pb / IN K N P0 P1 PB1 PB11 PB2 PB21 PT)
   
5.   ;点表排序
   
6.   (setq k(if(equal (car (nth 0 pb))(car (nth 1 pb)) 0.0001) 1 0 )
   
7.         n(length pb) in 0 pb1'() pb2'())
   
8.   (repeat n
   
9.     (setq pt(nth in pb) in (1+ in))
   
10.     (if pt
    
11.       (setq pb1(cons (nth k pt) pb1)
    
12.             pb2(append pb2 (list (cons (nth k pt) pt)))))
    
13.   )
    
14.   (setq pb11(lup pb1)n(length pb11)in 0
    
15.         p0(car pb11)pb21(list (dxf p0 pb2)))
    
16.   (repeat n
    
17.     (setq p1(nth in pb11))
    
18.     (if (equal p1 p0 0.0000001)
    
19.       (setq in (1+ in))
    
20.       (setq in (1+ in)
    
21.             pb21(append pb21 (list (dxf p1 pb2)))
    
22.             p0 p1)
    
23.     )
    
24.   )pb21
    
25. )
    
26. (defun dxf (#code #list)(cdr (assoc #code #list)))
    
27. 
    
28. (defun lup(a / b mn mx);;;对一个数字表排序，重复的忽略
    
29.   (setq mn (apply 'min a) mn (- mn 1000.))
    
30.   (while (> (setq mx (apply 'max a)) mn)
    
31.     (setq b (cons mx b) a (subst mn mx a))  )
    
32.   b)
    
33. 
    
34. 
    

<br /> 老lisp版的<br /> (defun #px-point1(pb / IN K N P0 P1 PB1 PB11 PB2 PB21 PT)<br />   ;点表排序<br />   (setq k(if(equal (car (nth 0 pb))(car (nth 1 pb)) 0.0001) 1 0 )<br />         n(length pb) in 0 pb1'() pb2'())<br />   (repeat n<br />     (setq pt(nth in pb) in (1+ in))<br />     (if pt<br />       (setq pb1(cons (nth k pt) pb1)<br />             pb2(append pb2 (list (cons (nth k pt) pt)))))<br />   )<br />   (setq pb11(lup pb1)n(length pb11)in 0<br />         p0(car pb11)pb21(list (dxf p0 pb2)))<br />   (repeat n<br />     (setq p1(nth in pb11))<br />     (if (equal p1 p0 0.0000001)<br />       (setq in (1+ in))<br />       (setq in (1+ in)<br />             pb21(append pb21 (list (dxf p1 pb2)))<br />             p0 p1)<br />     )<br />   )pb21<br /> )<br /> (defun dxf (#code #list)(cdr (assoc #code #list)))<br /> <br /> (defun lup(a / b mn mx);;;对一个数字表排序，重复的忽略<br />   (setq mn (apply 'min a) mn (- mn 1000.))<br />   (while (> (setq mx (apply 'max a)) mn)<br />     (setq b (cons mx b) a (subst mn mx a))  )<br />   b) <br /> <br /> <br />