[LISP函数]：帮忙看看该代码是否有bug

libo2000

直线与圆的交点
直线与圆弧的交点
帮忙看看该代码是否有bug，我实在很胡涂的了！

2. 
   
3.   [FONT=courier new]
   
4. ;直线与圆的交点
   
5. (defun chengs_getpoint_inters_ln2c ( p11 p12 c1 / ce1 p0 p1 p2 angr r w w1 w2 w3 result)
   
6. ;c1:圆；p11、p12：直线端点；ce1：圆心；p0：ce1到ln1的垂足
   
7. ;;;a1=ce1+angr1+ angr2+r
   
8.   (if (listp c1) (setq c1 (car c1)))
   
9.   (setq
   
10.            ce1 (cdr (assoc 10 (entget c1)))
    
11.            angr (angle p11 p12)
    
12.            r (cdr (assoc 40 (entget c1)))
    
13.            p0 (chengs_getpoint_per ce1 p11 p12)
    
14.            w (distance ce1 p0)
    
15.            w1 (distance ce1 p11)
    
16.            w2 (distance ce1 p12)
    
17.   )
    
18.   (if (equal w r 0.0000001) (setq w r))
    
19.   (if (equal w1 r 0.0000001) (setq w1 r))
    
20.   (if (equal w2 r 0.0000001) (setq w2 r))
    
21.   (if (< w r)
    
22.     (progn
    
23.       (setq w3 (sqrt (- (* r r) (* w w))))
    
24.       (if (>= w1 r) (setq p1 (polar p0 angr (* w3 -1))) )
    
25.       (if (>= w2 r) (setq p2 (polar p0 angr w3)) )
    
26.     )
    
27.     (progn
    
28.       (if (= w r) (setq p1 p0 p2 nil) )
    
29.       (if (> w r) (setq p1 nil p2 nil) )
    
30.     )
    
31.   );交点p1 p2
    
32. 
    
33.   ;判断p1 p2是否在线上
    
34.   (if p1
    
35.     (progn
    
36.       (setq w1 (distance p1 p11)
    
37.                w2 (distance p1 p12)
    
38.                w (distance p11 p12)
    
39.       )
    
40.       (if  (> (+ w1 w2 -0.0000001) w) (setq p1 nil))
    
41.     )
    
42.   );endif p1
    
43.   (if p2
    
44.     (progn
    
45.       (setq w1 (distance p2 p11)
    
46.                w2 (distance p2 p12)
    
47.                w (distance p11 p12)
    
48.       )
    
49.       (if  (> (+ w1 w2 -0.0000001) w) (setq p2 nil))
    
50.     )
    
51.   );endif p2
    
52.   (if p1 (setq result (list p1)))
    
53.   (if p2 (setq result (list p2)))
    
54.   (if (and p1 p2) (setq result (list p1 p2)))
    
55.   result
    
56. );endfun chengs_getpoint_inters_ln2c
    
57. 
    
58. ;;直线与圆弧的交点
    
59. (defun chengs_getpoint_inters_ln2a ( p11 p12 a1  / ce1 p1 p2 p3 p4 p1_ p2_ angr1 angr2 r result)
    
60. ;;p11 p12直线端点
    
61. 
    
62.   (if (listp a1) (setq a1 (car a1)))
    
63.   (setq
    
64.            ce1 (cdr (assoc 10 (entget a1))) ;圆心
    
65.            r (cdr (assoc 40 (entget a1))) ;弧半径
    
66.            angr1 (cdr (assoc 50 (entget a1))) ;弧角度1
    
67.            angr2 (cdr (assoc 51 (entget a1))) ;弧角度2
    
68.            p3 (polar ce1 angr1 r) ;弧点1
    
69.            p4 (polar ce1 angr2 r) ;弧点2
    
70.   )
    
71. 
    
72.   (setq p1 (chengs_getpoint_inters_ln2c p11 p12 a1)
    
73.            p2 (cadr p1)
    
74.            p1 (car p1)
    
75.   );圆的交点p1 p2
    
76. 
    
77.   ;判断是否优弧（大弧）
    
78.   (setq r (- angr2 angr1) )
    
79.   (if (< r 0.0) (setq r (+ (* 2 pi) r)))  ;弧端点连线角度
    
80. 
    
81.   (if (or (equal p1 p3 0.00001) (equal p1 p4 0.00001)) (setq p1_ p1 p1 nil)) ;p1等于弧端点
    
82.   (if (or (equal p2 p3 0.00001) (equal p2 p4 0.00001)) (setq p2_ p2 p2 nil)) ;p2等于弧端点
    
83.   
    
84.   (cond
    
85.     ( (> r pi)
    
86.       (progn  ;优弧两端点与ce1->p1有交点，则p1不在弧上
    
87.         (if p1 (if (inters p3 p4 ce1 p1) (setq p1 nil)))
    
88.         (if p2 (if (inters p3 p4 ce1 p2) (setq p2 nil)))
    
89.       )
    
90.     );endcond >180
    
91.     ( (< r pi)
    
92.       (progn  ;劣弧两端点与ce1->p1没有交点，则p1不在弧上
    
93.         (if p1 (if (not (inters p3 p4 ce1 p1)) (setq p1 nil)))
    
94.         (if p2 (if (not (inters p3 p4 ce1 p2)) (setq p2 nil)))
    
95.       )
    
96.     );endcond <180
    
97.     ( (= r pi)
    
98.       (progn  ;如果ce1->p1角度不在angr1 angr2之间，则p1不在弧上
    
99.         (if (> angr2 angr1)
    
100.           (progn
     
101.             (setq angr (angle ce1 p1))
     
102.             (if (and (> angr angr1) (< angr angr2))  ; 如果angr=angr1,angr2，则p1等于弧端点，即p1_
     
103.               (princ)
     
104.               (setq p1 nil)
     
105.             )
     
106.             (setq angr (angle ce1 p2))
     
107.             (if (and (> angr angr1) (< angr angr2))  ;angr=angr1,angr2，则p2等于弧端点，即p2_
     
108.               (princ)
     
109.               (setq p2 nil)
     
110.             )
     
111.           )
     
112.           (progn  ;angr1 > angr2 如果angr=angr1,angr2，则p1等于弧端点，即p1_
     
113.             (if p1 (setq angr (angle ce1 p1) ))
     
114.             (if (and (< angr angr1) (> angr angr2))  
     
115.               (setq p1 nil)
     
116.             )
     
117.             (if p2 (setq angr (angle ce1 p2)))
     
118.             (if (and (< angr angr1) (> angr angr2))
     
119.               (setq p2 nil)
     
120.             )
     
121.           )
     
122.         );endif angr2>angr1
     
123.       )
     
124.     );endcond =180
     
125.   );endcond r
     
126. 
     
127.   (if p1_ (setq p1 p1_))
     
128.   (if p2_ (setq p2 p2_))
     
129.   (if p1 (setq result (list p1)))
     
130.   (if p2 (setq result (list p2)))
     
131.   (if (and p1 p2) (setq result (list p1 p2)))
     
132. 
     
133.   result
     
134. );endfun chengs_getpoint_inters_ln2a
     
135.   [/FONT]
     

<br />   [FONT=courier new]<br /> ;直线与圆的交点<br /> (defun chengs_getpoint_inters_ln2c ( p11 p12 c1 / ce1 p0 p1 p2 angr r w w1 w2 w3 result)<br /> ;c1:圆；p11、p12：直线端点；ce1：圆心；p0：ce1到ln1的垂足<br /> ;;;a1=ce1+angr1+ angr2+r<br />   (if (listp c1) (setq c1 (car c1)))<br />   (setq<br />            ce1 (cdr (assoc 10 (entget c1)))<br />            angr (angle p11 p12)<br />            r (cdr (assoc 40 (entget c1)))<br />            p0 (chengs_getpoint_per ce1 p11 p12)<br />            w (distance ce1 p0)<br />            w1 (distance ce1 p11)<br />            w2 (distance ce1 p12)<br />   )<br />   (if (equal w r 0.0000001) (setq w r))<br />   (if (equal w1 r 0.0000001) (setq w1 r))<br />   (if (equal w2 r 0.0000001) (setq w2 r))<br />   (if (< w r)<br />     (progn<br />       (setq w3 (sqrt (- (* r r) (* w w))))<br />       (if (>= w1 r) (setq p1 (polar p0 angr (* w3 -1))) )<br />       (if (>= w2 r) (setq p2 (polar p0 angr w3)) )<br />     )<br />     (progn<br />       (if (= w r) (setq p1 p0 p2 nil) )<br />       (if (> w r) (setq p1 nil p2 nil) )<br />     )<br />   );交点p1 p2<br /> <br />   ;判断p1 p2是否在线上<br />   (if p1<br />     (progn<br />       (setq w1 (distance p1 p11) <br />                w2 (distance p1 p12)<br />                w (distance p11 p12)<br />       )<br />       (if  (> (+ w1 w2 -0.0000001) w) (setq p1 nil))<br />     )<br />   );endif p1<br />   (if p2<br />     (progn<br />       (setq w1 (distance p2 p11) <br />                w2 (distance p2 p12)<br />                w (distance p11 p12)<br />       )<br />       (if  (> (+ w1 w2 -0.0000001) w) (setq p2 nil))<br />     )<br />   );endif p2<br />   (if p1 (setq result (list p1)))<br />   (if p2 (setq result (list p2)))<br />   (if (and p1 p2) (setq result (list p1 p2)))<br />   result<br /> );endfun chengs_getpoint_inters_ln2c<br /> <br /> ;;直线与圆弧的交点<br /> (defun chengs_getpoint_inters_ln2a ( p11 p12 a1  / ce1 p1 p2 p3 p4 p1_ p2_ angr1 angr2 r result)<br /> ;;p11 p12直线端点<br /> <br />   (if (listp a1) (setq a1 (car a1)))<br />   (setq<br />            ce1 (cdr (assoc 10 (entget a1))) ;圆心<br />            r (cdr (assoc 40 (entget a1))) ;弧半径<br />            angr1 (cdr (assoc 50 (entget a1))) ;弧角度1<br />            angr2 (cdr (assoc 51 (entget a1))) ;弧角度2<br />            p3 (polar ce1 angr1 r) ;弧点1<br />            p4 (polar ce1 angr2 r) ;弧点2<br />   )<br /> <br />   (setq p1 (chengs_getpoint_inters_ln2c p11 p12 a1)<br />            p2 (cadr p1)<br />            p1 (car p1)<br />   );圆的交点p1 p2<br /> <br />   ;判断是否优弧（大弧）<br />   (setq r (- angr2 angr1) )<br />   (if (< r 0.0) (setq r (+ (* 2 pi) r)))  ;弧端点连线角度<br /> <br />   (if (or (equal p1 p3 0.00001) (equal p1 p4 0.00001)) (setq p1_ p1 p1 nil)) ;p1等于弧端点<br />   (if (or (equal p2 p3 0.00001) (equal p2 p4 0.00001)) (setq p2_ p2 p2 nil)) ;p2等于弧端点<br />   <br />   (cond<br />     ( (> r pi)<br />       (progn  ;优弧两端点与ce1->p1有交点，则p1不在弧上<br />         (if p1 (if (inters p3 p4 ce1 p1) (setq p1 nil)))<br />         (if p2 (if (inters p3 p4 ce1 p2) (setq p2 nil))) <br />       )<br />     );endcond >180<br />     ( (< r pi)<br />       (progn  ;劣弧两端点与ce1->p1没有交点，则p1不在弧上<br />         (if p1 (if (not (inters p3 p4 ce1 p1)) (setq p1 nil)))<br />         (if p2 (if (not (inters p3 p4 ce1 p2)) (setq p2 nil))) <br />       )<br />     );endcond <180<br />     ( (= r pi)<br />       (progn  ;如果ce1->p1角度不在angr1 angr2之间，则p1不在弧上<br />         (if (> angr2 angr1)<br />           (progn<br />             (setq angr (angle ce1 p1))<br />             (if (and (> angr angr1) (< angr angr2))  ; 如果angr=angr1,angr2，则p1等于弧端点，即p1_<br />               (princ)<br />               (setq p1 nil)<br />             )<br />             (setq angr (angle ce1 p2))<br />             (if (and (> angr angr1) (< angr angr2))  ;angr=angr1,angr2，则p2等于弧端点，即p2_<br />               (princ)<br />               (setq p2 nil)<br />             )<br />           )<br />           (progn  ;angr1 > angr2 如果angr=angr1,angr2，则p1等于弧端点，即p1_<br />             (if p1 (setq angr (angle ce1 p1) ))<br />             (if (and (< angr angr1) (> angr angr2))  <br />               (setq p1 nil)<br />             )<br />             (if p2 (setq angr (angle ce1 p2)))<br />             (if (and (< angr angr1) (> angr angr2))<br />               (setq p2 nil)<br />             )<br />           )<br />         );endif angr2>angr1<br />       )<br />     );endcond =180<br />   );endcond r<br /> <br />   (if p1_ (setq p1 p1_))<br />   (if p2_ (setq p2 p2_))<br />   (if p1 (setq result (list p1)))<br />   (if p2 (setq result (list p2)))<br />   (if (and p1 p2) (setq result (list p1 p2)))<br /> <br />   result<br /> );endfun chengs_getpoint_inters_ln2a<br />   [/FONT]<br />

eachy

还是用ActiveX方法好

陌生人

同意楼上说法，给一个例子

2. 
   
3. ;;明经通道LISP示例-求两曲线交点
   
4. (defun c:GIP ()
   
5.   (c:getinterpoint)
   
6. )
   
7. (defun C:GetInterPoint (/        ent1     ent2     ent_1    ent_2
   
8.                         ax_ent_1 ax_ent_2 intpoints         i
   
9.                         j        k        disp
   
10.                        )
    
11.   (vl-load-com)
    
12.   (setq ent1 (entsel "\n选择第一条曲线:"))
    
13.   (setq ent2 (entsel "\n选择第二条曲线:"))
    
14.   (setq ent_1 (car ent1)
    
15.         ent_2 (car ent2)
    
16.   )
    
17.   (setq ax_ent_1 (vlax-ename->vla-object ent_1)
    
18.         ax_ent_2 (vlax-ename->vla-object ent_2)
    
19.   )
    
20.   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
    
21.   (setq intpoints (vlax-variant-value intpoints))
    
22.   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
    
23.     (progn
    
24.       (setq i 0)
    
25.       (setq j 0)
    
26.       (setq k 0)
    
27.       (setq disp "")
    
28.       (repeat
    
29.         (/ (+ 1
    
30.               (- (vlax-safearray-get-u-bound intpoints 1)
    
31.                  (vlax-safearray-get-l-bound intpoints 1)
    
32.               )
    
33.            )
    
34.            3
    
35.         )
    
36.          (setq
    
37.            disp (strcat
    
38.                   disp
    
39.                   "\n交点"
    
40.                   (itoa (+ k 1))
    
41.                   "坐标为:"
    
42.                   (rtos (vlax-safearray-get-element intpoints j))
    
43.                   " , "
    
44.                   (rtos (vlax-safearray-get-element intpoints (+ 1 j)))
    
45.                   " , "
    
46.                   (rtos (vlax-safearray-get-element intpoints (+ 2 j)))
    
47.                 )
    
48.          )
    
49.          (setq i (+ 2 i)
    
50.                j (+ 3 j)
    
51.                k (+ 1 k)
    
52.          )
    
53.       )
    
54.       (princ disp)
    
55.     )
    
56.     (princ "\n两曲线没有交点")
    
57.   )
    
58.   (princ "\n明经通道LISP示例-求两曲线交点")
    
59.   (princ)
    
60. )
    

<br /> ;;明经通道LISP示例-求两曲线交点<br /> (defun c:GIP ()<br />   (c:getinterpoint)<br /> )<br /> (defun C:GetInterPoint (/        ent1     ent2     ent_1    ent_2<br />                         ax_ent_1 ax_ent_2 intpoints         i<br />                         j        k        disp<br />                        )<br />   (vl-load-com)<br />   (setq ent1 (entsel "\n选择第一条曲线:"))<br />   (setq ent2 (entsel "\n选择第二条曲线:"))<br />   (setq ent_1 (car ent1)<br />         ent_2 (car ent2)<br />   )<br />   (setq ax_ent_1 (vlax-ename->vla-object ent_1)<br />         ax_ent_2 (vlax-ename->vla-object ent_2)<br />   )<br />   (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))<br />   (setq intpoints (vlax-variant-value intpoints))<br />   (if (> (vlax-safearray-get-u-bound intpoints 1) 0)<br />     (progn<br />       (setq i 0)<br />       (setq j 0)<br />       (setq k 0)<br />       (setq disp "")<br />       (repeat<br />         (/ (+ 1<br />               (- (vlax-safearray-get-u-bound intpoints 1)<br />                  (vlax-safearray-get-l-bound intpoints 1)<br />               )<br />            )<br />            3<br />         )<br />          (setq<br />            disp (strcat<br />                   disp<br />                   "\n交点"<br />                   (itoa (+ k 1))<br />                   "坐标为:"<br />                   (rtos (vlax-safearray-get-element intpoints j))<br />                   " , "<br />                   (rtos (vlax-safearray-get-element intpoints (+ 1 j)))<br />                   " , "<br />                   (rtos (vlax-safearray-get-element intpoints (+ 2 j)))<br />                 )<br />          )<br />          (setq i (+ 2 i)<br />                j (+ 3 j)<br />                k (+ 1 k)<br />          )<br />       )<br />       (princ disp)<br />     )<br />     (princ "\n两曲线没有交点")<br />   )<br />   (princ "\n明经通道LISP示例-求两曲线交点")<br />   (princ)<br /> )<br />

libo2000

用vl 函数的确好，问题是：我到现在还不知道如何把（defun C:GetInterPoint）编译成R14下可以运行的文件，   .vlx？2000还差不多，R14运行不了。
请问如何将其编译成.arx或其他R14可执行文件？

陌生人

编译为 .fas