（XD::Polyline:Append-half-Circle）在多段线上一点增加指定半径的半圆

newer

1. (defun xd::polyline:append-half-circle (e     pnt   radius info        /
   
2.                                         b1    b2    bulge cir        ept
   
3.                                         g1    g2    garc1 garc2        ints
   
4.                                         inx   inxs  midp  p1        p3
   
5.                                         r     seg   segs  spt        tf
   
6.                                         typ   v            x          y        yno
   
7.                                        )
   
8.   (xdrx-curve->polyline e)
   
9.   (setq pnt (xdrx-curve-getclosestpoint e pnt))
   
10.   (setq tf t)
    
11.   (setq        inx (car (xdrx-getpropertyvalue e "onSegat" pnt))
    
12.         typ (xdrx-polyline-segtype e inx)
    
13.         spt (xdrx-polyline-getpointat e inx)
    
14.         ept (xdrx-polyline-getpointat e (1+ inx))
    
15.   )
    
16.   (if (or (and (= typ "kArc")
    
17.                (setq cir (xdrx-getpropertyvalue e "ArcSegAt" inx))
    
18.           )
    
19.           (and (= typ "kLine")
    
20.                (= (xdrx-polyline-segtype e (1- inx)) "kArc")
    
21.                (setq cir (xdrx-getpropertyvalue e "ArcSegAt" (1- inx)))
    
22.                (xdge::getpropertyvalue cir "ison" pnt)
    
23.           )
    
24.       )
    
25.     (progn (setq r (xdrx-getpropertyvalue cir "radius"))
    
26.            (if (not (< radius (/ r 3.0)))
    
27.              (progn (xdrx-prompt info)
    
28.                     (setq tf nil)
    
29.              )
    
30.            )
    
31.            (xdge::free cir)
    
32.     )
    
33.   )
    
34.   (if tf
    
35.     (progn
    
36.       (setq cir         (xdge::constructor "kcircarc3d" pnt '(0 0 1.0) radius)
    
37.             ints (xdrx-get-inters cir e)
    
38.             v         (xdrx-curve-getfirstderiv e pnt)
    
39.       )
    
40.       (xdge::free cir)
    
41.       (if (xdrx-vector-iscodirectional v '(1 0 0) (/ pi 2.0))
    
42.         (setq bulge -1.0)
    
43.         (setq bulge 1.0)
    
44.       )
    
45.       (if (= (length ints) 2)
    
46.         (progn
    
47.           (if (= (xdrx-polyline-segtype e inx) "kArc")
    
48.             (progn (setq inxs  (vl-sort
    
49.                                  (mapcar
    
50.                                    '(lambda (x)
    
51.                                       (list (xdrx-curve-getparamatpoint e x) x)
    
52.                                     )
    
53.                                    ints
    
54.                                  )
    
55.                                  '(lambda (x y) (< (car x) (car y)))
    
56.                                )
    
57.                          p1    (cadar inxs)
    
58.                          p3    (cadadr inxs)
    
59.                          garc1 (xdrx-polyline-getarcsegat e inx t)
    
60.                          garc2 (xdge::copy garc1)
    
61.                          g1    (xdge::setpropertyvalue garc1 "setinterval" spt p1)
    
62.                          midp  (xdrx-getpropertyvalue g1 "midpoint")
    
63.                          b1    (xdrx-getpropertyvalue g1 "bulge")
    
64.                          b1    (if (XD::Clockwise-p spt midp p1)
    
65.                                  (- b1)
    
66.                                  b1
    
67.                                )
    
68.                          g2    (xdge::setpropertyvalue
    
69.                                  garc2
    
70.                                  "setinterval"
    
71.                                  (cadadr inxs)
    
72.                                  ept
    
73.                                )
    
74.                          b2    (xdrx-getpropertyvalue g2 "bulge")
    
75.                          midp  (xdrx-getpropertyvalue g2 "midpoint")
    
76.                          b2    (if (XD::Clockwise-p p3 midp ept)
    
77.                                  (- b2)
    
78.                                  b2
    
79.                                )
    
80.                    )
    
81.               (xdge::free garc1 garc2 g2)
    
82.             )
    
83.           )
    
84.           (xdrx-polyline-addvertexat e (1+ inx) (car ints))
    
85.           (setq seg (xdrx-getpropertyvalue e "onsegat" pnt))
    
86.           (xdrx-polyline-addvertexat e (1+ (car seg)) (cadr ints))
    
87.           (setq
    
88.             segs (vl-sort
    
89.                    (list (xdrx-curve-getparamatpoint e (car ints))
    
90.                          (xdrx-curve-getparamatpoint e (cadr ints))
    
91.                    )
    
92.                    '(lambda (x y) (< x y))
    
93.                  )
    
94.           )
    
95.           (xdrx-setpropertyvalue e "bulgeat" (list (car segs) bulge))
    
96.           (xdrx-setpropertyvalue e "bulgeat" (list inx b1))
    
97.           (xdrx-setpropertyvalue e "bulgeat" (list (cadr segs) b2))
    
98.         )
    
99.       )
    
100.     )
     
101.   )
     
102. )
     

(defun xd::polyline:append-half-circle (e     pnt   radius info        /<br />                                         b1    b2    bulge cir        ept<br />                                         g1    g2    garc1 garc2        ints<br />                                         inx   inxs  midp  p1        p3<br />                                         r     seg   segs  spt        tf<br />                                         typ   v            x          y        yno<br />                                        )<br />   (xdrx-curve->polyline e)<br />   (setq pnt (xdrx-curve-getclosestpoint e pnt))<br />   (setq tf t)<br />   (setq        inx (car (xdrx-getpropertyvalue e "onSegat" pnt))<br />         typ (xdrx-polyline-segtype e inx)<br />         spt (xdrx-polyline-getpointat e inx)<br />         ept (xdrx-polyline-getpointat e (1+ inx))<br />   )<br />   (if (or (and (= typ "kArc")<br />                (setq cir (xdrx-getpropertyvalue e "ArcSegAt" inx))<br />           )<br />           (and (= typ "kLine")<br />                (= (xdrx-polyline-segtype e (1- inx)) "kArc")<br />                (setq cir (xdrx-getpropertyvalue e "ArcSegAt" (1- inx)))<br />                (xdge::getpropertyvalue cir "ison" pnt)<br />           )<br />       )<br />     (progn (setq r (xdrx-getpropertyvalue cir "radius"))<br />            (if (not (< radius (/ r 3.0)))<br />              (progn (xdrx-prompt info)<br />                     (setq tf nil)<br />              )<br />            )<br />            (xdge::free cir)<br />     )<br />   )<br />   (if tf<br />     (progn<br />       (setq cir         (xdge::constructor "kcircarc3d" pnt '(0 0 1.0) radius)<br />             ints (xdrx-get-inters cir e)<br />             v         (xdrx-curve-getfirstderiv e pnt)<br />       )<br />       (xdge::free cir)<br />       (if (xdrx-vector-iscodirectional v '(1 0 0) (/ pi 2.0))<br />         (setq bulge -1.0)<br />         (setq bulge 1.0)<br />       )<br />       (if (= (length ints) 2)<br />         (progn<br />           (if (= (xdrx-polyline-segtype e inx) "kArc")<br />             (progn (setq inxs  (vl-sort<br />                                  (mapcar<br />                                    '(lambda (x)<br />                                       (list (xdrx-curve-getparamatpoint e x) x)<br />                                     )<br />                                    ints<br />                                  )<br />                                  '(lambda (x y) (< (car x) (car y)))<br />                                )<br />                          p1    (cadar inxs)<br />                          p3    (cadadr inxs)<br />                          garc1 (xdrx-polyline-getarcsegat e inx t)<br />                          garc2 (xdge::copy garc1)<br />                          g1    (xdge::setpropertyvalue garc1 "setinterval" spt p1)<br />                          midp  (xdrx-getpropertyvalue g1 "midpoint")<br />                          b1    (xdrx-getpropertyvalue g1 "bulge")<br />                          b1    (if (XD::Clockwise-p spt midp p1)<br />                                  (- b1)<br />                                  b1<br />                                )<br />                          g2    (xdge::setpropertyvalue<br />                                  garc2<br />                                  "setinterval"<br />                                  (cadadr inxs)<br />                                  ept<br />                                )<br />                          b2    (xdrx-getpropertyvalue g2 "bulge")<br />                          midp  (xdrx-getpropertyvalue g2 "midpoint")<br />                          b2    (if (XD::Clockwise-p p3 midp ept)<br />                                  (- b2)<br />                                  b2<br />                                )<br />                    )<br />               (xdge::free garc1 garc2 g2)<br />             )<br />           )<br />           (xdrx-polyline-addvertexat e (1+ inx) (car ints))<br />           (setq seg (xdrx-getpropertyvalue e "onsegat" pnt))<br />           (xdrx-polyline-addvertexat e (1+ (car seg)) (cadr ints))<br />           (setq<br />             segs (vl-sort<br />                    (list (xdrx-curve-getparamatpoint e (car ints))<br />                          (xdrx-curve-getparamatpoint e (cadr ints))<br />                    )<br />                    '(lambda (x y) (< x y))<br />                  )<br />           )<br />           (xdrx-setpropertyvalue e "bulgeat" (list (car segs) bulge))<br />           (xdrx-setpropertyvalue e "bulgeat" (list inx b1))<br />           (xdrx-setpropertyvalue e "bulgeat" (list (cadr segs) b2))<br />         )<br />       )<br />     )<br />   )<br /> )<br />

qq1254582201

学习一下，好东西正是我需要的！！

既然青春留不住