两圆公切线

Lispboy

1. (defun c:xdtb_cir2tan (/           ss         c1    c2    cen1  cen2         dir   dir1  dir2
   
2.              p1           p2         g1    g2    pa1   pa2         pa-1  pa-2  gl1
   
3.              gl2   sp1         ep1   sp2   ep2   arc1         arc2
   
4.             )
   
5.   (if (and (xdrx_initssget "\n选择两个圆<退出>:")
   
6.            (setq ss (xdrx_ssget '((0 . "circle"))))
   
7.            (= (sslength ss) 2)
   
8.       )
   
9.     (progn
   
10.       (xdrx_begin)
    
11.       (setq c1         (ssname ss 0)
    
12.             c2         (ssname ss 1)
    
13.             cen1 (xdrx_getpropertyvalue c1 "center")
    
14.             cen2 (xdrx_getpropertyvalue c2 "center")
    
15.             int1 (xdrx_get_inters c1 (list cen1 cen2) 3)
    
16.             int2 (xdrx_get_inters c2 (list cen1 cen2) 3)
    
17.             int3 (mapcar 'car
    
18.                          (xdrx_points_sortoncurve
    
19.                            (list cen1 cen2)
    
20.                            (append int1 int2)
    
21.                          )
    
22.                  )
    
23.             dir         (xdrx_vector_normalize (mapcar '- cen1 cen2))
    
24.             dir1 (xdrx_vector_perpvector dir)
    
25.             dir2 (xdrx_vector_negate dir1)
    
26.             p1         (xdrx_get_inters c1 (list cen1 (mapcar '+ cen1 dir1)) 3)
    
27.             p2         (xdrx_get_inters c2 (list cen2 (mapcar '+ cen2 dir1)) 3)
    
28.             p1         (mapcar 'car
    
29.                          (xdrx_points_sortoncurve
    
30.                            (list cen1 (mapcar '+ cen1 dir1))
    
31.                            p1
    
32.                          )
    
33.                  )
    
34.             p2         (mapcar 'car
    
35.                          (xdrx_points_sortoncurve
    
36.                            (list cen2 (mapcar '+ cen2 dir1))
    
37.                            p2
    
38.                          )
    
39.                  )
    
40.             g1         (xdge::constructor c1)
    
41.             g2         (xdge::constructor c2)
    
42.             pa1         (xdge::getpropertyvalue g1 "paramof" (car p1))
    
43.             pa2         (xdge::getpropertyvalue g1 "paramof" (cadr p1))
    
44.             pa-1 (xdge::getpropertyvalue g2 "paramof" (car p2))
    
45.             pa-2 (xdge::getpropertyvalue g2 "paramof" (cadr p2))
    
46.             gl1         (xdge::constructor "klineseg3d")
    
47.             gl2         (xdge::constructor "klineseg3d")
    
48.       )
    
49.       (if (and (xdge::setpropertyvalue gl1 "set" g1 g2 pa1 pa-1)
    
50.                (xdge::setpropertyvalue gl2 "set" g1 g2 pa2 pa-2)
    
51.           )
    
52.         (progn
    
53.           (mapcar 'set
    
54.                   '(sP1 eP1)
    
55.                   (xdge::getpropertyvalue gl1 "startpoint" "endpoint")
    
56.           )
    
57.           (mapcar 'set
    
58.                   '(sP2 eP2)
    
59.                   (xdge::getpropertyvalue gl2 "startpoint" "endpoint")
    
60.           )
    
61.           (setq
    
62.             arc1 (xdge::constructor "kCircArc3d" sp1 (car int3) sp2)
    
63.           )
    
64.           (setq
    
65.             arc2 (xdge::constructor "kCircArc3d" ep1 (last int3) ep2)
    
66.           )
    
67.           (xdrx_curve_join (xdge::entity:make gl1 gl2 arc1 arc2))
    
68.           (xdrx_entity_matchprop c1 (entlast))
    
69.           (xdrx_entity_delete ss)
    
70.         )
    
71.         (xdrx_prompt "\n >>两圆没有公切线.")
    
72.       )
    
73.       (xdrx_end)
    
74.     )
    
75.     (xdrx_prompt "\n >>没有选择到两个圆.")
    
76.   )
    
77.   (princ)
    
78. )
    

(defun c:xdtb_cir2tan (/           ss         c1    c2    cen1  cen2         dir   dir1  dir2<br />              p1           p2         g1    g2    pa1   pa2         pa-1  pa-2  gl1<br />              gl2   sp1         ep1   sp2   ep2   arc1         arc2<br />             )<br />   (if (and (xdrx_initssget "\n选择两个圆<退出>:")<br />            (setq ss (xdrx_ssget '((0 . "circle"))))<br />            (= (sslength ss) 2)<br />       )<br />     (progn<br />       (xdrx_begin)<br />       (setq c1         (ssname ss 0)<br />             c2         (ssname ss 1)<br />             cen1 (xdrx_getpropertyvalue c1 "center")<br />             cen2 (xdrx_getpropertyvalue c2 "center")<br />             int1 (xdrx_get_inters c1 (list cen1 cen2) 3)<br />             int2 (xdrx_get_inters c2 (list cen1 cen2) 3)<br />             int3 (mapcar 'car<br />                          (xdrx_points_sortoncurve<br />                            (list cen1 cen2)<br />                            (append int1 int2)<br />                          )<br />                  )<br />             dir         (xdrx_vector_normalize (mapcar '- cen1 cen2))<br />             dir1 (xdrx_vector_perpvector dir)<br />             dir2 (xdrx_vector_negate dir1)<br />             p1         (xdrx_get_inters c1 (list cen1 (mapcar '+ cen1 dir1)) 3)<br />             p2         (xdrx_get_inters c2 (list cen2 (mapcar '+ cen2 dir1)) 3)<br />             p1         (mapcar 'car<br />                          (xdrx_points_sortoncurve<br />                            (list cen1 (mapcar '+ cen1 dir1))<br />                            p1<br />                          )<br />                  )<br />             p2         (mapcar 'car<br />                          (xdrx_points_sortoncurve<br />                            (list cen2 (mapcar '+ cen2 dir1))<br />                            p2<br />                          )<br />                  )<br />             g1         (xdge::constructor c1)<br />             g2         (xdge::constructor c2)<br />             pa1         (xdge::getpropertyvalue g1 "paramof" (car p1))<br />             pa2         (xdge::getpropertyvalue g1 "paramof" (cadr p1))<br />             pa-1 (xdge::getpropertyvalue g2 "paramof" (car p2))<br />             pa-2 (xdge::getpropertyvalue g2 "paramof" (cadr p2))<br />             gl1         (xdge::constructor "klineseg3d")<br />             gl2         (xdge::constructor "klineseg3d")<br />       )<br />       (if (and (xdge::setpropertyvalue gl1 "set" g1 g2 pa1 pa-1)<br />                (xdge::setpropertyvalue gl2 "set" g1 g2 pa2 pa-2)<br />           )<br />         (progn<br />           (mapcar 'set<br />                   '(sP1 eP1)<br />                   (xdge::getpropertyvalue gl1 "startpoint" "endpoint")<br />           )<br />           (mapcar 'set<br />                   '(sP2 eP2)<br />                   (xdge::getpropertyvalue gl2 "startpoint" "endpoint")<br />           )<br />           (setq<br />             arc1 (xdge::constructor "kCircArc3d" sp1 (car int3) sp2)<br />           )<br />           (setq<br />             arc2 (xdge::constructor "kCircArc3d" ep1 (last int3) ep2)<br />           )<br />           (xdrx_curve_join (xdge::entity:make gl1 gl2 arc1 arc2))<br />           (xdrx_entity_matchprop c1 (entlast))<br />           (xdrx_entity_delete ss)<br />         )<br />         (xdrx_prompt "\n >>两圆没有公切线.")<br />       )<br />       (xdrx_end)<br />     )<br />     (xdrx_prompt "\n >>没有选择到两个圆.")<br />   )<br />   (princ)<br /> )<br />

tzfcn

有点意思。很好玩

coverne

先来测试一下

kqqt6236

很实用的功能。

echizenace

谢谢楼主分享！

kiwiairui

                    

cfc123456

很实用的功能