通用函数 算法 拟合圆弧(非精确).LSP

分类:lisp函数 | 标签: lisp   算法   拟合   圆弧  
2020-02-03 12:33 阅读(?)评论(0)

;;;=================================================================*
;;;    算法  拟合圆弧                                               *
;;;参数:lst_pt -----二维点表                                       *
(defun zl-sj-nhyh (lst_pt / LST_R LST_TMP LST_X LST_Y N PTA PTB PTC R X Y)
    ;;根据X坐标进行排序
    (setq lst_pt
	     (vl-sort lst_pt
		      (function	(lambda	(e1 e2)
				    (< (car e1) (car e2))
				)
		      )
	     )
    )
    ;;获取相距最远的两点为基本点
    (setq pta	 (car lst_pt)
	  ptb	 (last lst_pt)
	  lst_pt (cdr lst_pt) ;_去掉最前一个
	  lst_pt (cdr (reverse lst_pt)) ;_去掉最后一个
    )
    ;;逐个计算半径及圆心
    (setq lst_tmp (mapcar '(lambda (ptc)
			       (zl-sf-nhyh-01 pta ptb ptc)
			   )
			  lst_pt
		  )
    )

    (princ lst_tmp)

    ;;剔除最大半径、最小半径
    (setq lst_tmp
	     (vl-sort lst_tmp
		      (function	(lambda	(e1 e2)
				    (< (caddr e1) (caddr e2))
				)
		      )
	     )
    )
;;;	    (setq lst_tmp (cdr lst_tmp) ;_去掉最前一个
;;;		  lst_tmp (cdr lst_tmp)
;;;		  lst_tmp (cdr(reverse lst_tmp));_去掉最后一个
;;;	    )

    ;;计算平均圆心、平均半径
    (setq n	(length lst_tmp)
	  lst_x	(mapcar 'car lst_tmp)
	  x	(/ (apply '+ lst_x) 1.0 n)
	  lst_y	(mapcar 'cadr lst_tmp)
	  y	(/ (apply '+ lst_y) 1.0 n)
	  lst_r	(mapcar 'caddr lst_tmp)
	  r	(/ (apply '+ lst_r) 1.0 n)
    )
    ;;返回(圆心坐标X  Y  半径R)
    (list x y r)
)
;;;=================================================================*
;;;功能:已知不共线三点,求圆心及半径                               *
(defun zl-sf-nhyh-01
       (pta ptb ptc / ANG1 ANG2 PT10 PT20 PT_MID1 PT_MID2 PT R)
    (setq pt_mid1 (list	(* 0.5 (+ (car pta) (car ptb)))
			(* 0.5 (+ (cadr pta) (cadr ptb)))
		  )
	  ang1	  (angle pta ptb)
	  ang1	  (+ ang1 (* 0.5 pi))
	  pt10	  (polar pt_mid1 ang1 10)
    )
    (setq pt_mid2 (list	(* 0.5 (+ (car ptb) (car ptc)))
			(* 0.5 (+ (cadr ptb) (cadr ptc)))
		  )
	  ang2	  (angle ptb ptc)
	  ang2	  (+ ang2 (* 0.5 pi))
	  pt20	  (polar pt_mid2 ang2 10)
    )
    ;;圆心  及  半径
    (setq pt (inters pt_mid1 pt10 pt_mid2 pt20 nil)
	  R  (distance pt pta)
    )
    ;;返回(圆心x  圆心y  半径r)
    (list (car pt) (cadr pt) r)
)
;;;=================================================================*
;;;测试   拟合圆弧                                                  *
(defun c:nhyh ( / SS ENT I LST_PT PT PTA PTB R  TMP X Y)
    (princ "\n请选择要拟合的点位: ")
    (if	(and (setq ss (ssget '((0 . "POINT"))))
	     (>= (sslength ss) 3)
	)
	(progn
	    ;;获取点位
	    (setq lst_pt '()
		  i 0
	    )
	    (repeat (sslength ss)
		(setq ent    (entget (ssname ss i))
		      pt     (cdr (assoc 10 ent))
		      pt     (list (car pt) (cadr pt)) ;_转换为二维
		      lst_pt (cons pt lst_pt)
		)
		(setq i (1+ i))
	    )

	    (setq tmp (zl-sj-nhyh lst_pt)
		  x   (car tmp)
		  y   (cadr tmp)
		  r   (caddr tmp)
	    )
	    ;;绘制圆
	    (command "_.circle" "non" (list x y) r)
	)
    )
    (princ)
)
;;;=================================================================*
(princ)

  最后修改于 2020-02-03 14:37    阅读(?)评论(0)
 
表  情:
加载中...
 

请各位遵纪守法并注意语言文明