明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1336|回复: 4

[函数] 点表求最小包围圆,返回圆心、半径

[复制链接]
发表于 2014-12-18 19:02 | 显示全部楼层 |阅读模式
本帖最后由 wzg356 于 2014-12-19 00:05 编辑


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

  70. ;;测试
  71. (defun c:tt2 ( / plst arcptr)
  72. (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)))
  73. (command "pline" (foreach pt ptlst (command pt)))
  74. (setq arcptr(ptlst2arc ptlst))
  75. (command "circle" (car arcptr) (cadr arcptr))
  76. )
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2014-12-18 19:19 | 显示全部楼层
朋友:'(lambda (rest /),这是什么高招?指点指点,谢谢!
 楼主| 发表于 2014-12-18 19:24 | 显示全部楼层
434939575 发表于 2014-12-18 19:19
朋友:'(lambda (rest /),这是什么高招?指点指点,谢谢!

整个'(lambda (rest /)...)是mapcdr函数的参数_-表达式
发表于 2014-12-18 22:36 | 显示全部楼层
哦,谢谢哝@
发表于 2014-12-19 07:48 | 显示全部楼层
感谢 wzg356 分享程序!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-30 00:02 , Processed in 0.238561 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表