[求助]LISP能求出椭圆弧长吗?

HRQ28 · 发表于 2010-8-5 09:24:00

LISP能求出椭圆弧长吗?

据网上多位高人说，计算椭圆任意两点间的弧长是世界难题。

因还是看到有人克服战胜困难，我也想请教明经上的高手，有没有一种相对精确而简易可行的计算公式，

或用LISP来计算椭圆任意两点间的弧长。

不知这样的想法，会不会有结果。

就算没结果，能让明经上的高人看看，也算是我的努力了。

感谢这里众多热心的高手。

xshrimp · 发表于 2010-8-5 10:27:00

直接可以量出来啊.

(setq n (car (entsel)))

(setq curve (vlax-ename->vla-object n))

(setq tlen (vlax-curve-getdistatparam curve (vlax-curve-getendparam curve) ))

Gu_xl · 发表于 2010-8-5 10:29:00

;;;计算椭圆任意两点间逆时针方向距离
(defun c:tt ()
(princ "\n选择椭圆：")
(setq en (car (entsel)))
(redraw en 3)
(setq d (vlax-curve-getDistAtparam en (vlax-curve-getendparam en))
d0 (/ d 100)
)
(setq p1 (osnap (getpoint "\n选择椭圆任意第一点：") "_nea"))
(grdraw (polar p1 pi d0) (polar p1 0 d0) 1)
(grdraw (polar p1 (/ pi 2) d0) (polar p1 (* pi 1.5) d0) 1)
(setq p2 (osnap (getpoint "\n选择椭圆任意第二点：") "_nea"))
(grdraw (polar p2 pi d0) (polar p2 0 d0) 1)
(grdraw (polar p2 (/ pi 2) d0) (polar p2 (* pi 1.5) d0) 1)
(setq p1 (vlax-curve-getclosestpointto en p1)
p2 (vlax-curve-getclosestpointto en p2)
)
(setq d1 (vlax-curve-getDistAtPoint en p1)
d2 (vlax-curve-getDistAtPoint en p2)
)
(if (> d2 d1) (setq rtn (- d2 d1)) (setq rtn (+ d (- d2 d1))))
(princ "\n第一点:X = ")
(princ (car p1))
(princ " Y = ")
(princ (cadr p1))
(princ " 第二点:X = ")
(princ (car p2))
(princ " Y = ")
(princ (cadr p2))
(princ " 距离 = ")
(princ rtn)
(redraw en 4)
(princ)
)

HRQ28 · 发表于 2010-8-5 15:06:00

感谢楼上两位高手的热心说明.

但我总想找到一种通过点坐标直接计算出弧长的方式.

不知道有无这种方法?

或者是在LISP中设定一个椭圆尺寸,再将其设为如24等分,再求出各等分点坐标,再通过坐标求出弧长.

或通过给定弧长,反求出坐标点更好.

但这些工作都是LISP自动化完成,而不需手工从图中点取坐标.

不知这样的想法是不是太高了.

ZZXXQQ · 发表于 2010-8-5 21:54:00

不知楼主到底要怎么计算？如果不用人选择，数据从哪来？是不是还要人工输入？

masterlong · 发表于 2010-8-5 22:33:00

如果要直接算出弧长

那应该先去翻一下平面几何的书

椭圆的周长是没有精确解的

自然椭圆弧也不可能有精确解

参照这个你再仔细考虑下你的需求

有没有继续研究的必要

highflybird · 发表于 2010-8-6 08:26:00

楼主的要求实际上是可以实现的，关键是精度问题。
下面的程序在精度要求不很高的情况下，可以满足。
至于对话框的设计和出错，这个程序就没有考虑了。
有时间写一个精度比较高的。
实际上如果要在lisp中运行，你也可以这样做：
输入参数后，由参数反推椭圆弧的起始角度和终止角度,用参数创建一个椭圆，然后得到弧长，然后删除掉这个弧，这样也能满足精度要求。

;;; 计算椭圆弧长的程序
;;; 稍加改造就可以计算任何曲线的弧长
;;; 或者计算积分
;;; highflybird 2012-12-21 in Shenzhen
(defun c:test ();;(/ a b x y k c s A1 A2 AA C)
(initget 7)
(setq a (getdist "\n请输入椭圆的长轴:"))
(initget 7)
(setq b (getdist "\n请输入椭圆的短轴:"))
(setq x (getreal "\n起点X1= ")) ;建议改成起始角度
(setq y (getreal "\n终点X2= ")) ;建议改成终止角度
(if (not (and a b x y))
(exit)
)
(setq k (/ b a)) ;比率
(setq c (1- (* k k)))
(setq aa (/ 1.0 a a))
;;反求角度
(setq a1 (atan (sqrt (* b b (- 1 (* x x aa)))) x))
(setq a2 (atan (sqrt (* b b (- 1 (* y y aa)))) y))
;;积分函数
(defun func (x)
(sqrt (1+ (* (sin x) (sin x) c)))
)
(setq s (* a (qsimp a1 a2)))
;;(setq s (* a (qsimp x y))) ;如果这个地方为角度是不是更精确些呢?
(princ "\n弧长是:")
(princ (rtos s 2 20))
(princ "\n周长是:")
(princ (rtos (approx a b) 2 20))
(princ)
)
;;; 求椭圆周长的公式
(defun approx (a b / c d e)
(setq c (+ a b))
(setq d (- a b))
(setq e (/ (* d d) (* c c)))
(* pi c (1+ (/ (* 3 e) (+ 10 (sqrt (- 4 (* 3 e)))))))
)
;;; 步长积分法
(defun trapzd (a b n / DEL IT SUM TNM X)
(if (= n 1)
(setq s (* 0.5 (- b a) (+ (func a) (func b))))
(progn
(setq it 1)
(repeat (- n 2)
(setq it (lsh it 1))
)
(setq tnm it)
(setq del (/ (- b a) tnm))
(setq x (+ a (* 0.5 del)))
(setq sum 0.0)
(repeat it
(setq sum (+ sum (func x)))
(setq x (+ x del))
)
(setq s (* 0.5 (+ s (/ (* (- b a) sum) tnm))))
)
)
)
;;; 辛普森积分法
(defun qsimp (a b / EPS J JMAX OS OST s ST)
(setq JMAX 20)
(setq EPS 1.0e-10)
(setq ost 0.0
os 0.0
)
(setq j 0)
(while (< j JMAX)
(setq st (trapzd a b (1+ j)))
(setq s (/ (- (* 4.0 st) ost) 3.0))
(if (> j 5)
(if (or (< (abs (- s os)) (* EPS (abs os)))
(and (= s 0.0) (= os 0.0))
)
(setq j JMAX)
)
)
(setq os s)
(setq ost st)
(setq j (1+ j))
)
s
)

;;; 计算椭圆弧长的程序
;;; 稍加改造就可以计算任何曲线的弧长
;;; 或者计算积分
;;; highflybird  2012-12-21 in Shenzhen
(defun c:test ();;(/ a b x y k c s A1 A2 AA C)
  (initget 7)
  (setq a (getdist "\n请输入椭圆的长轴:")) 
  (initget 7)
  (setq b (getdist "\n请输入椭圆的短轴:")) 
  (setq x (getreal "\n起点X1= "))   ;建议改成起始角度
  (setq y (getreal "\n终点X2= "))             ;建议改成终止角度
  (if (not (and a b x y))
    (exit)
  )
  (setq k (/ b a))     ;比率
  (setq c (1- (* k k)))
  (setq aa (/ 1.0 a a))
  ;;反求角度
  (setq a1 (atan (sqrt (* b b (- 1 (* x x aa)))) x))
  (setq a2 (atan (sqrt (* b b (- 1 (* y y aa)))) y))
  ;;积分函数
  (defun func (x)
    (sqrt (1+ (* (sin x) (sin x) c)))
  )
  (setq s (* a (qsimp a1 a2)))
  ;;(setq s (* a (qsimp x y)))     ;如果这个地方为角度是不是更精确些呢?
  (princ "\n弧长是:")
  (princ (rtos s 2 20))
  (princ "\n周长是:")
  (princ (rtos (approx a b) 2 20))
  (princ)
)
;;; 求椭圆周长的公式
(defun approx (a b / c d e)
  (setq c (+ a b))
  (setq d (- a b))
  (setq e (/ (* d d) (* c c)))
  (* pi c (1+ (/ (* 3 e) (+ 10 (sqrt (- 4 (* 3 e)))))))
)
;;; 步长积分法
(defun trapzd (a b n / DEL IT SUM TNM X)
  (if (= n 1)
    (setq s (* 0.5 (- b a) (+ (func a) (func b))))
    (progn
      (setq it 1)
      (repeat (- n 2)
 (setq it (lsh it 1))
      )
      (setq tnm it)
      (setq del (/ (- b a) tnm))
      (setq x (+ a (* 0.5 del)))
      (setq sum 0.0)
      (repeat it
 (setq sum (+ sum (func x)))
 (setq x (+ x del))
      )
      (setq s (* 0.5 (+ s (/ (* (- b a) sum) tnm))))
    )
  )
)
;;; 辛普森积分法
(defun qsimp (a b / EPS J JMAX OS OST s ST)
  (setq JMAX 20)
  (setq EPS 1.0e-10)
  (setq ost 0.0
 os  0.0
  )
  (setq j 0)
  (while (< j JMAX)
    (setq st (trapzd a b (1+ j)))
    (setq s (/ (- (* 4.0 st) ost) 3.0))
    (if (> j 5)
      (if (or (< (abs (- s os)) (* EPS (abs os)))
       (and (= s 0.0) (= os 0.0))
   )
 (setq j JMAX)
      )
    )
    (setq os s)
    (setq ost st)
    (setq j (1+ j))
  )
  s
)

yoyoho · 发表于 2010-8-6 09:23:00

感谢诸位楼主,

收藏学习!

HRQ28 · 发表于 2010-8-6 14:35:00

感谢ZZXXQQ版主一针见血的说明，这个问题的的应用在于椭圆构件的展开放样计算。

1、已知椭圆长短圆及椭圆心点（即长短轴交点）坐标；

2、已知椭圆周长要等分成N等分段

求解：

每个等分点的坐标？

目前根据ZZXXQQ版主及网上找到的精确椭圆周长计算公式，已可以在误差远远小于万分之一的精度下求出椭圆周长，除N等分段后也就每等分段的椭圆弧长，但根据此弧长，如何求出各等分段弧长分界点的坐标（相对椭圆轴心点的坐标）？？？

求出了这些坐标点之后，也就可以计算出椭圆构件的展开下料样图了。

因为网上都说这类计算是世界难题无精确解，但我想总有个相对精确的答案吧。

这才来明经这个CAD高手如云的地方，请各位高手指点指点。

Andyhon · 发表于 2010-8-6 15:42:00

分成N等分段?
用 Divide 命令不成吗?

账号		自动登录	找回密码
密码			注册

[求助]LISP能求出椭圆弧长吗?

本帖子中包含更多资源

本帖子中包含更多资源