大家写下处理圆弧的函数

XDSoft

XDRX_API里面有个函数



这个函数对处理圆弧或者多段线的弧段的时候非常有用，大家练练LISP，用LISP写出来这个函数。

ayl1004

1. 
   
2. (defun xdrx_3ptoarc (pt1 pt2 pt3 / pt4 Radius cpt sAng eAng lst)
   
3. (setq Radius nil cpt nil sAng nil eAng nil lst nil)
   
4. ;;计算半径
   
5. (defun EvaRadius (L H)
   
6. (/ (+ (* L L) (* H H)) H 2.0)
   
7. )
   
8. ;;调用
   
9. (setq Pt4 (mapcar '* (mapcar '+ Pt1 Pt3) '(0.5 0.5 0.5)))
   
10. (and
    
11. ;;判断三点是否共线
    
12. (not (equal (distance pt4 pt2) 0 0.00001))
    
13. (equal (distance pt1 pt2) (distance pt2 pt3) 0.00001)
    
14. ;;半径
    
15. (setq Radius (EvaRadius (distance pt1 Pt4) (distance pt2 Pt4)))
    
16. ;;圆心
    
17. (setq cpt (polar pt2 (angle pt2 pt4) Radius))
    
18. (setq sAng (angle cpt pt1))
    
19. (setq eAng (angle cpt pt3))
    
20. (setq lst (list cpt pt1 pt2))
    
21. (setq lst (vl-sort
    
22.                (vl-sort lst '(lambda (x y) (< (car x) (car y))))
    
23.               '(lambda (x y) (< (cadr x) (cadr y)))
    
24.             )
    
25. )
    
26. (setq lst (mapcar 'angle lst (cons (last lst) lst)))
    
27. (setq lst (vl-every '< lst (cdr lst)))
    
28. )
    
29. (list lst cpt Radius sAng eAng)
    
30. )
    

<br /> (defun xdrx_3ptoarc (pt1 pt2 pt3 / pt4 Radius cpt sAng eAng lst)<br /> (setq Radius nil cpt nil sAng nil eAng nil lst nil)<br /> ;;计算半径<br /> (defun EvaRadius (L H)<br /> (/ (+ (* L L) (* H H)) H 2.0)<br /> )<br /> ;;调用<br /> (setq Pt4 (mapcar '* (mapcar '+ Pt1 Pt3) '(0.5 0.5 0.5)))<br /> (and<br /> ;;判断三点是否共线<br /> (not (equal (distance pt4 pt2) 0 0.00001))<br /> (equal (distance pt1 pt2) (distance pt2 pt3) 0.00001)<br /> ;;半径<br /> (setq Radius (EvaRadius (distance pt1 Pt4) (distance pt2 Pt4)))<br /> ;;圆心<br /> (setq cpt (polar pt2 (angle pt2 pt4) Radius))<br /> (setq sAng (angle cpt pt1))<br /> (setq eAng (angle cpt pt3))<br /> (setq lst (list cpt pt1 pt2))<br /> (setq lst (vl-sort <br />                (vl-sort lst '(lambda (x y) (< (car x) (car y)))) <br />               '(lambda (x y) (< (cadr x) (cadr y)))<br />             )<br /> )<br /> (setq lst (mapcar 'angle lst (cons (last lst) lst)))<br /> (setq lst (vl-every '< lst (cdr lst)))<br /> )<br /> (list lst cpt Radius sAng eAng)<br /> )<br />