博客年龄:17年7个月 访问:?次 文章:470篇
;;;=================================================================* ;;; 算法 拟合圆弧 * ;;;参数: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)
请各位遵纪守法并注意语言文明
评论 想第一时间抢沙发么?