点表求最小包围圆，返回圆心、半径

wzg356

自己用不上，学习兴趣来了写的
大量数据没测试过

2. ;;;点表求最小包围圆，返回圆心、半径
   
3. ;;; by wzg356 于201411216
   
4. ;;; ==================================================================
   
5. (defun ptlst2arc (ptlst / yy-3arc perPt mapcdr ppdl maxdpp p1p2 p1 p2 perlst p3 maxperl minr)
   
6. ;三点求圆弧圆心半径  by wan1314
   
7. (defun yy-3arc (p1 p2 p3 / z1 z2 yxin)
   
8.     (setq z1 (mapcar  '(lambda (x y)(/ (+ x y) 2.0))  p1 p2)
   
9.         z2 (mapcar  '(lambda (x y)(/ (+ x y) 2.0))  p1 p3)
   
10.     )
    
11.     (if
    
12.         (setq yxin (inters
    
13.                 z1 (polar z1 (+ (angle p1 p2)(* pi 0.5)) 10)
    
14.                 z2 (polar z2 (+ (angle p1 p3)(* pi 0.5)) 10)
    
15.                 nil
    
16.             )
    
17.         )
    
18.         (list yxin (distance yxin p1))
    
19.     )
    
20. )
    
21. ;;;功能: 点到直线的垂足,距离,来自明经贴
    
22. (defun perPt (P p1 p2 / pt)
    
23.   (setq pt (polar p (+ (* 0.5 pi) (angle p1 p2)) 10.0))
    
24.   (list (setq pt (inters p1 p2 p pt nil)) (distance p pt))
    
25. )
    
26. ;重复对表的0之后元素组成的表进行表达式操作
    
27. ;http://bbs.xdcad.net/forum.php?mod=viewthread&tid=568299
    
28. (defun mapcdr (expr liste / retl)
    
29.   (repeat (1- (length liste))
    
30.     (setq retl (cons (apply expr (list liste)) retl))
    
31.     (setq liste (cdr liste))
    
32.   )
    
33.   (reverse retl)
    
34. )
    
35. (setq ppdl
    
36.   (apply  'append
    
37.     (mapcdr
    
38.       '(lambda (rest /)
    
39.                (mapcar
    
40.                  '(lambda (car-von-rest /)
    
41.                       (list(car rest)car-von-rest (distance (car rest)car-von-rest))
    
42.                     )
    
43.                  (cdr rest)
    
44.                )
    
45.             );用mapcdr确保两两组合
    
46.               ptlst
    
47.          )
    
48.      )
    
49. );((list 点 点 距离)...)的表
    
50. (setq maxd
    
51.   (apply 'max (setq maxdpp(mapcar '(lambda(x)(caddr x)) ppdl)))
    
52. )
    
53. (setq p1p2 (nth (vl-position maxd maxdpp) ppdl))
    
54. (setq p1 (car p1p2) p2 (cadr p1p2));距离最大的两点
    
55. (setq perlst
    
56.   (mapcar '(lambda(p)(cadr(perPt p p1 p2)))ptlst)
    
57. );所有点与距离最大的两点的(垂距.....)
    
58. (setq p3
    
59.   (nth  
    
60.     (vl-position (setq maxperl (apply 'max perlst))perlst)
    
61.     ptlst
    
62.   )
    
63. );与距离最大的两点垂距最大的点
    
64. (if (> maxperl (setq minr(/ maxd 2)))
    
65.   (yy-3arc p1 p2 p3);得到三点圆弧圆心、半径
    
66.   (list (mapcar  '(lambda (x y)(/ (+ x y) 2.0))  p1 p2)
    
67.     minr
    
68.   );最大距离两点为直径的圆心、半径  
    
69. )
    
70. )
    
71. 
    
72. ;;测试
    
73. (defun c:tt2 ( / plst arcptr)
    
74. (setq  ptlst (list (list 12 0 0)(list 12 13 0)(list 16 19 0)(list 28 9 0)(list 17 4 0)(list 9 12 0)))
    
75. (command "pline" (foreach pt ptlst (command pt)))
    
76. (setq arcptr(ptlst2arc ptlst))
    
77. (command "circle" (car arcptr) (cadr arcptr))
    
78. )

;;;点表求最小包围圆，返回圆心、半径<br /> ;;; by wzg356 于201411216<br /> ;;; ==================================================================<br /> (defun ptlst2arc (ptlst / yy-3arc perPt mapcdr ppdl maxdpp p1p2 p1 p2 perlst p3 maxperl minr)<br /> ;三点求圆弧圆心半径  by wan1314<br /> (defun yy-3arc (p1 p2 p3 / z1 z2 yxin) <br />     (setq z1 (mapcar  '(lambda (x y)(/ (+ x y) 2.0))  p1 p2)<br />         z2 (mapcar  '(lambda (x y)(/ (+ x y) 2.0))  p1 p3)<br />     )<br />     (if<br />         (setq yxin (inters<br />                 z1 (polar z1 (+ (angle p1 p2)(* pi 0.5)) 10)<br />                 z2 (polar z2 (+ (angle p1 p3)(* pi 0.5)) 10)<br />                 nil<br />             )<br />         )<br />         (list yxin (distance yxin p1))<br />     )<br /> )<br /> ;;;功能: 点到直线的垂足,距离,来自明经贴<br /> (defun perPt (P p1 p2 / pt)<br />   (setq pt (polar p (+ (* 0.5 pi) (angle p1 p2)) 10.0))<br />   (list (setq pt (inters p1 p2 p pt nil)) (distance p pt))<br /> )<br /> ;重复对表的0之后元素组成的表进行表达式操作<br /> ;http://bbs.xdcad.net/forum.php?mod=viewthread&tid=568299<br /> (defun mapcdr (expr liste / retl)<br />   (repeat (1- (length liste))<br />     (setq retl (cons (apply expr (list liste)) retl))<br />     (setq liste (cdr liste))<br />   )<br />   (reverse retl)<br /> )<br /> (setq ppdl<br />   (apply  'append<br />     (mapcdr <br />       '(lambda (rest /)<br />                (mapcar <br />                  '(lambda (car-von-rest /) <br />                       (list(car rest)car-von-rest (distance (car rest)car-von-rest))<br />                     )<br />                  (cdr rest)<br />                )<br />             );用mapcdr确保两两组合 <br />               ptlst<br />          )<br />      )<br /> );((list 点 点 距离)...)的表<br /> (setq maxd <br />   (apply 'max (setq maxdpp(mapcar '(lambda(x)(caddr x)) ppdl)))<br /> )<br /> (setq p1p2 (nth (vl-position maxd maxdpp) ppdl))<br /> (setq p1 (car p1p2) p2 (cadr p1p2));距离最大的两点<br /> (setq perlst<br />   (mapcar '(lambda(p)(cadr(perPt p p1 p2)))ptlst)<br /> );所有点与距离最大的两点的(垂距.....)<br /> (setq p3 <br />   (nth  <br />     (vl-position (setq maxperl (apply 'max perlst))perlst) <br />     ptlst<br />   )<br /> );与距离最大的两点垂距最大的点<br /> (if (> maxperl (setq minr(/ maxd 2)))<br />   (yy-3arc p1 p2 p3);得到三点圆弧圆心、半径<br />   (list (mapcar  '(lambda (x y)(/ (+ x y) 2.0))  p1 p2)<br />     minr<br />   );最大距离两点为直径的圆心、半径  <br /> )<br /> )<br /> <br /> ;;测试<br /> (defun c:tt2 ( / plst arcptr)<br /> (setq  ptlst (list (list 12 0 0)(list 12 13 0)(list 16 19 0)(list 28 9 0)(list 17 4 0)(list 9 12 0)))<br /> (command "pline" (foreach pt ptlst (command pt)))<br /> (setq arcptr(ptlst2arc ptlst))<br /> (command "circle" (car arcptr) (cadr arcptr))<br /> )

434939575

朋友：'(lambda (rest /)，这是什么高招？指点指点，谢谢！

wzg356

434939575 发表于 2014-12-18 19:19
朋友：'(lambda (rest /)，这是什么高招？指点指点，谢谢！

整个'(lambda (rest /)...)是mapcdr函数的参数_-表达式

434939575

哦，谢谢哝@

yoyoho

感谢 wzg356 分享程序!