大家写下从多段线的弧段信息获得圆弧的参数

XDSoft

XDRX_API有个函数



大家试试用LISP写写。

夏生生

简单测试了一下是对的，是否满足所有条件请大家测试
[pcode=lisp,true](defun xdrx_polytoarc (start_pt bulge end_pt / mid_pt v dis h d m cen start_ang end_ang)
  (setq mid_pt (mapcar
                 '(lambda (x)
                    (/ x 2)
                  )
                 (mapcar
                   '+
                   start_pt
                   end_pt
                 )
               )                       ; 弦中心
        v (mapcar
            '-
            end_pt
            start_pt
          )
  )
  (if (< bulge 0)
    (setq v v)
    (setq v (mapcar
              '-
              v
            )
    )
  )
  (setq dis (sqrt (apply
                    '+
                    (mapcar
                      '(lambda (x)
                         (* x x)
                       )
                      v
                    )
                  )
            )                               ; 弦长
        h (/ (* (abs bulge) dis) 2)    ; 矢高
        d (/ (+ h (/ (* dis dis) 4 h)) 2) ; 半径
        m (mapcar
            '(lambda (x)
               (* (/ (- d h) dis) x)
             )
            v
          )
        cen (list (+ (car mid_pt) (cadr m)) (- (cadr mid_pt) (car m)))
        v (mapcar
            '-
            start_pt
            cen
          )
        start_ang (atan (cadr v) (car v))
        v (mapcar
            '-
            end_pt
            cen
          )
        end_ang (atan (cadr v) (car v))
  )
  (if (< bulge 0)
    (list nil cen d end_ang start_ang)
    (list t cen d start_ang end_ang)
  )
)
[/pcode]

Love-Lisp

1. (defun xdrx_polytoarc ( p1  bulg  p2 / ang cen rad )
   
2.   (setq ang (* 2.0 (atan bulg))
   
3.         rad (/ (distance p1 p2) (* 2.0 (sin ang)))
   
4.         cen (polar p1 (+ (- (/ pi 2.) ang) (angle p1 p2)) rad)
   
5.   )
   
6.   (if (minusp bulg)
   
7.     (list nil cen (abs rad) (angle cen p2) (angle cen p1) )
   
8.     (list t cen (abs rad) (angle cen p1) (angle cen p2) )
   
9.   )
   
10. )

(defun xdrx_polytoarc ( p1  bulg  p2 / ang cen rad )<br />   (setq ang (* 2.0 (atan bulg))<br />         rad (/ (distance p1 p2) (* 2.0 (sin ang)))<br />         cen (polar p1 (+ (- (/ pi 2.) ang) (angle p1 p2)) rad)<br />   )<br />   (if (minusp bulg)<br />     (list nil cen (abs rad) (angle cen p2) (angle cen p1) )<br />     (list t cen (abs rad) (angle cen p1) (angle cen p2) )<br />   )<br /> )

XDSoft

Love-Lisp 发表于 2013-6-11 11:17

楼上朋友，如果测试没问题，用函数发布 发布下吧。谢谢！ 贴内做个图片说明下最好了。

ayl1004

2. (defun xdex_PolyToArc (sPt Bg ePt / L H R sePt cPt)
   
3.   (if
   
4.     (cond
   
5.       ((equal Bg 0 0.00001) nil)
   
6.       ((< Bg 0)
   
7.        (setq Tor nil
   
8.              Bg         (abs Bg)
   
9.        )
   
10.       )
    
11.       ((> Bg 0) (setq Tor t))
    
12.       (t nil)
    
13.     )
    
14.     (progn
    
15.       (if (> Bg 1)
    
16.         (setq Bg (/ 1.0 Bg))
    
17.       )
    
18.       (setq L    (* (distance sPt ePt) 0.5)
    
19.             H    (* L Bg)
    
20.             R    (* (+ (/ L Bg) H) 0.5)
    
21.             sePt (mapcar '* (mapcar '+ sPt ePt) '(0.5 0.5 0.5))
    
22.       )
    
23.       (if Tor
    
24.         (setq cPt (polar sePt (+ (angle sPt ePt) (* pi 0.5)) (- R H)))
    
25.         (setq cPt (polar sePt (- (angle sPt ePt) (* pi 0.5)) (- R H)))
    
26.       )
    
27.       (list Tor cPt R (angle cPt sPt) (angle cPt ePt))
    
28.     )
    
29.   )
    
30. )

(defun xdex_PolyToArc (sPt Bg ePt / L H R sePt cPt)<br />   (if<br />     (cond<br />       ((equal Bg 0 0.00001) nil)<br />       ((< Bg 0)<br />        (setq Tor nil<br />              Bg         (abs Bg)<br />        )<br />       )<br />       ((> Bg 0) (setq Tor t))<br />       (t nil)<br />     )<br />     (progn<br />       (if (> Bg 1)<br />         (setq Bg (/ 1.0 Bg))<br />       )<br />       (setq L    (* (distance sPt ePt) 0.5)<br />             H    (* L Bg)<br />             R    (* (+ (/ L Bg) H) 0.5)<br />             sePt (mapcar '* (mapcar '+ sPt ePt) '(0.5 0.5 0.5))<br />       )<br />       (if Tor<br />         (setq cPt (polar sePt (+ (angle sPt ePt) (* pi 0.5)) (- R H)))<br />         (setq cPt (polar sePt (- (angle sPt ePt) (* pi 0.5)) (- R H)))<br />       )<br />       (list Tor cPt R (angle cPt sPt) (angle cPt ePt))<br />     )<br />   )<br /> )