[LISP函数]：制作Donut

eachy

2. 
   
3. ;;制作 Donut
   
4. ;;;画圆环 r1内径r2 外 径
   
5. (defun xd-MkDonut (p0 r1 r2 / P1 P2 R RR ent)
   
6.   (setq        r  (/ (+ r1 r2) 2.0)
   
7.         rr (- r2 r1)
   
8.         p1 (polar p0 0 (- r))
   
9.         p2 (polar p0 0 r)
   
10.   )
    
11.   (if (setq ent        (entmakex (list        '(0 . "LWPOLYLINE")
    
12.                                 '(100 . "AcDbEntity")
    
13.                                 '(67 . 0)
    
14.                                 '(100 . "AcDbPolyline")
    
15.                                 '(90 . 2)
    
16.                                 '(70 . 1)
    
17.                                 '(38 . 0.0)
    
18.                                 '(39 . 0.0)
    
19.                                 (cons 10 p1)
    
20.                                 (cons 40 rr)
    
21.                                 (cons 41 rr)
    
22.                                 '(42 . 1.0)
    
23.                                 (cons 10 p2)
    
24.                                 (cons 40 rr)
    
25.                                 (cons 41 rr)
    
26.                                 '(42 . 1.0)
    
27.                           )
    
28.                 )
    
29.       )
    
30.     ent
    
31.   )
    
32. )
    
33. (defun xd-addpline (vla-obj pts)
    
34.   (vla-addlightweightpolyline
    
35.     vla-obj
    
36.     (vlax-make-variant
    
37.       (vlax-safearray-fill
    
38.         (vlax-make-safearray
    
39.           vlax-vbdouble
    
40.           (cons 0 (1- (* 2 (length pts))))
    
41.         )
    
42.         (apply 'append
    
43.                (mapcar '(lambda (x) (list (car x) (cadr x))) pts)
    
44.         )
    
45.       )
    
46.     )
    
47.   )
    
48. )
    
49. ;;;画圆环 r1内径r2 外 径
    
50. (defun xd-adddonut (obj p0 r1 r2 / r w p1 p2 pln)
    
51.   (setq        r  (/ (+ r1 r2) 2.)
    
52.         w  (abs (- r1 r2))
    
53.         p1 (polar p0 0. r)
    
54.         p2 (polar p0 pi r)
    
55.   )
    
56.   (setq pln (xd-addpline obj (list p1 p2)))
    
57.   (mapcar '(lambda (x) (vla-setBulge pln (car x) (cdr x)))
    
58.           '((0 . 1.0) (1 . 1.0))
    
59.   )
    
60.   (vla-put-ConstantWidth pln w)
    
61.   (vla-put-closed pln :vlax-true)
    
62.   pln
    
63. )

<br /> ;;制作 Donut<br /> ;;;画圆环 r1内径r2 外 径<br /> (defun xd-MkDonut (p0 r1 r2 / P1 P2 R RR ent)<br />   (setq        r  (/ (+ r1 r2) 2.0)<br />         rr (- r2 r1)<br />         p1 (polar p0 0 (- r))<br />         p2 (polar p0 0 r)<br />   )<br />   (if (setq ent        (entmakex (list        '(0 . "LWPOLYLINE")<br />                                 '(100 . "AcDbEntity")<br />                                 '(67 . 0)<br />                                 '(100 . "AcDbPolyline")<br />                                 '(90 . 2)<br />                                 '(70 . 1)<br />                                 '(38 . 0.0)<br />                                 '(39 . 0.0)<br />                                 (cons 10 p1)<br />                                 (cons 40 rr)<br />                                 (cons 41 rr)<br />                                 '(42 . 1.0)<br />                                 (cons 10 p2)<br />                                 (cons 40 rr)<br />                                 (cons 41 rr)<br />                                 '(42 . 1.0)<br />                           )<br />                 )<br />       )<br />     ent<br />   )<br /> )<br /> (defun xd-addpline (vla-obj pts)<br />   (vla-addlightweightpolyline<br />     vla-obj<br />     (vlax-make-variant<br />       (vlax-safearray-fill<br />         (vlax-make-safearray<br />           vlax-vbdouble<br />           (cons 0 (1- (* 2 (length pts))))<br />         )<br />         (apply 'append<br />                (mapcar '(lambda (x) (list (car x) (cadr x))) pts)<br />         )<br />       )<br />     )<br />   )<br /> )<br /> ;;;画圆环 r1内径r2 外 径<br /> (defun xd-adddonut (obj p0 r1 r2 / r w p1 p2 pln)<br />   (setq        r  (/ (+ r1 r2) 2.)<br />         w  (abs (- r1 r2))<br />         p1 (polar p0 0. r)<br />         p2 (polar p0 pi r)<br />   )<br />   (setq pln (xd-addpline obj (list p1 p2)))<br />   (mapcar '(lambda (x) (vla-setBulge pln (car x) (cdr x)))<br />           '((0 . 1.0) (1 . 1.0))<br />   )<br />   (vla-put-ConstantWidth pln w)<br />   (vla-put-closed pln :vlax-true)<br />   pln<br /> )