本帖最后由 qjchen 于 2011-3-19 16:38 编辑
:) 此题确实是得用数值解法了
根据chenjun兄的解法,采用以前的二分法lisp编了一段LISP,不过最后是画出圆而没有画出弧
- ;;; By qjchen@gmail.com
- ;;; The main code mainly from the MIT book "Structure and interpretaion of computer programs"
- ;;; judge whether the initial range is suitable
- (defun halfsolve (f a b / a-value b-value)
- (setq a-value ((eval f) a)
- b-value ((eval f) b)
- )
-
- (cond
- ((and (< a-value 0) (> b-value 0)) (searchhalf f a b))
- ((and (> a-value 0) (< b-value 0)) (searchhalf f b a))
- ((= a-value 0) a)
- ((= b-value 0) b)
- (T (prompt "The Values maybe not between a and b"))
- )
- )
- ;;core code of dichotomy
- (defun searchhalf (f neg-point pos-point / test-value midpoint)
- (setq midpoint (/ (+ neg-point pos-point) 2))
- (cond
- ((close-enough? neg-point pos-point) midpoint)
- (T
- (setq test-value ((eval f) midpoint))
- (cond
- ((> test-value 0) (searchhalf f neg-point midpoint))
- ((< test-value 0) (searchhalf f midpoint pos-point))
- (T midpoint)
- )
- )
- )
- )
- ;;judge small enough
- (defun close-enough? (x y)
- (< (abs (- x y)) 1e-10)
- )
- ;; The equation to be solve, -x^3+2x+3=0
- ;; 2*x*sin(arcl/2/x)-linel
- (defun myfuntosolve (x)
- (- (* x 2.0 (sin (/ arclength 2. x))) linelength)
- )
- ;;Main function by qjchen@gmail.com
- (defun c:t( / a ang arclength d linelength p1 r)
- (setq a (vlax-ename->vla-object (car (entsel "\n Please select a line"))) arclength (getreal "\n Arc Length"))
- (setq linelength (Vlax-get a 'length))
- (if (> arclength linelength)
- (progn (princ (rtos (setq r (halfsolve myfuntosolve (/ linelength 2.0) (/ linelength 0.01))) 2 14))
- (setq P1 (Vlax-get a 'StartPoint)
- ang (Vlax-get a 'Angle)
- d (sqrt (- (* r r) (* linelength linelength 0.25))))
- (command "circle" (polar (polar P1 ang (* 0.5 linelength)) (+ ang (* 0.5 pi)) d) r)
- (command "circle" (polar (polar P1 ang (* 0.5 linelength)) (+ ang (* 0.5 pi)) (- d)) r)
- )
- (princ "the Arc length is too small")
- )
- (princ)
- )
|