折线变圆三种实现方法的比较

marting

找到三种折线拟合回圆的代码，其实是两种算法，

1、面域法，根据折线转成面域，求出型心，根据面积算出半径，这种方法缺陷是折线越少，面积差别越大，圆也就离原始圆差别大。
2、最小二乘圆拟合法，精度最高，因为拟合认为折线上的点都是圆上的点，所以拟合回的圆就是原来的圆，面积，圆心，半径都相同。




下面是三种代码：

1、面域法1

(defun c:tt1 (/ ss1 num cnt ename obj rp ar rad)
  (vl-load-com)
  (setq ss1 (ssget '((0 . "*polyline")))
    num (sslength ss1)
    cnt 0)
  (repeat num
    (setq ename (ssname ss1 cnt))
    (setq obj (vlax-ename->vla-object ename))
    (vlax-put-property obj 'Closed 1)
    (vl-cmdf "region" ename "")
    (setq obj (vlax-ename->vla-object (entlast)))
        (setq ar (vlax-get-property obj 'Area)
      rp (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'Centroid)))
      rad (sqrt (/ ar pi))
      )
    (entdel (entlast));remove this line if you want to keep original
    (vl-cmdf "circle" rp rad)
  (setq cnt (1+ cnt))
  )
  (princ)
)

2、面域法2

(defun c:tt2  (/ ss obj rp ar rad)
  (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "*POLYLINE")
                            (if (getvar "CTAB")
                              (cons 410 (getvar "CTAB"))
                              (cons 67 (- 1 (getvar "TILEMODE")))))))
    (foreach x (mapcar 'vlax-ename->vla-object
                 (vl-remove-if 'listp
                   (mapcar 'cadr (ssnamex ss))))
      (vlax-put-property x 'Closed 1)
      (vl-cmdf "_region" (vlax-vla-object->ename x) "")
      (setq obj (vlax-ename->vla-object (entlast))
            ar  (vlax-get-property obj 'Area)
            rp  (vlax-safearray->list
                  (vlax-variant-value
                    (vlax-get-property obj 'Centroid)))
            rad (sqrt (/ ar pi)))
      (vla-delete obj) ; -> Remove to Keep Original
      (vl-cmdf "_circle" rp rad))
    (princ "\n<!> Nothing Selected <!>"))
  (princ))

3、最小二乘圆拟合法

拟合函数 xd::pnts:fitcircle 见开源函数库：http://bbs.xdcad.net/thread-704455-1-1.html

(defun c:tt3 ()
  (if (setq e (ssget ":S:E" '((0 . "LWPOLYLINE"))))
    (progn
      (setq e        (ssname e 0)
            pts        (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget e))
            pts        (mapcar 'cdr pts)
            d        (xd::pnts:fitcircle pts)  ;;最小二乘圆拟合函数
      )
      (command ".circle" (car d) (cadr d))
    )
  )
  (princ)
)

cable2004

确实是难得好帖啊，顶先

yoyoho

啥也不说了，感谢楼主分享哇！