[求助]：这个是lisp出错了...

clearlai

2. 
   
3.   [FONT=courier new]
   
4. ;;;;;;测试程序
   
5. (defun c:ccc(/ a a2 tf)
   
6.   (setq a1 '(670.759 584.45 0.0))
   
7.   (setq a2 (list '(560.248 748.043 0.0) '(812.045 748.043 0.0) '(812.045 503.352 0.0) '(560.248 503.352 0.0)))
   
8.   (setq tf (ER_point-in-poly a1 a2))
   
9.   (princ "\n答案：")
   
10.   (princ tf)
    
11.   (princ)
    
12.   )
    
13. 
    
14. (defun ER_point-in-poly(xpt xdb / fhz mxb myb n i mx my nn p1 p2 p12 pxy a_line xpt1)
    
15.     (vl-load-com)
    
16.     (setq fhz 0
    
17.           mxb nil
    
18.           myb nil
    
19.           n   (length xdb)
    
20.           i   0
    
21.           xdb (append xdb (list (car xdb)))
    
22.     )
    
23.     ;;(setq xpt1 (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    
24.         ;;(setq xpt1 (vlax-safearray-fill xpt1 xpt))
    
25. 
    
26.   
    
27. ; 判断点xpt是否在多边形上
    
28.     (while(< i n)
    
29.         (setq acadobject   (vlax-get-acad-object)
    
30.               acadDocument (vla-get-activeDocument acadobject)
    
31.               mspace           (vla-get-modelspace acaddocument)
    
32.         )
    
33.         (setq p1 (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    
34.         (setq p1 (vlax-safearray-fill p1 (nth i xdb)))
    
35.         (setq p2 (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    
36.         (setq p2 (vlax-safearray-fill p2 (nth (1+ i) xdb)))
    
37.         (setq a_line (vla-addline mspace p1 p2))
    
38. 
    
39.         (vla-put-Color a_line 9)
    
40.         ;;(setq p1 (nth i xdb) p2 (nth (1+ i) xdb))
    
41.         ;;(command "line" p1 p2 "" "chprop" (entlast) "" "c" 9 "")
    
42.         ;;;(princ "\nhhhhhhhhhhhhhhhh")(princ a_line )
    
43.         (setq p12 (vlax-curve-getclosestpointto a_line xpt1));;;;;这里出现error: bad argument type: 2D/3D point
    
44. 
    
45.                
    
46.         (entdel a_line)
    
47.         ;若xpt至某一边的距离为零，则xpt在多边形上，因计算误差，设10的-6次方为与零的比较误差
    
48.         (if (equal (distance xpt1 p12) 0.0 1e-6) (setq fhz 1 i n))
    
49.         (setq i (1+ i))
    
50.     )
    
51. (if (/= fhz 1)
    
52.     ; 判断点xpt是否在多边形内
    
53.         (progn
    
54.         (foreach p12 xdb
    
55.            (setq mxb (append mxb (list (abs (- (car xpt1) (car p12)))))
    
56.                myb (append myb (list (abs (- (cadr xpt1) (cadr p12)))))
    
57.            )
    
58.         )
    
59.            (setq pxy (mapcar '+ xpt1 (list (* 2.0 (apply 'max mxb)) (apply 'min myb)))
    
60.           i 0   nn 0
    
61.            )
    
62.            (repeat n
    
63.            (if (inters xpt1 pxy (nth i xdb) (nth (1+ i) xdb)) (setq nn (1+ nn)))
    
64.            (setq i (1+ i))
    
65.            )
    
66.            (if (and (> nn 0) (/= nn (* (fix (/ nn 2.0)) 2.0))) (setq fhz 2))
    
67.         )
    
68.     )
    
69.     (setq fhz fhz)
    
70. )
    
71.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;;;;;测试程序<br /> (defun c:ccc(/ a a2 tf)<br />   (setq a1 '(670.759 584.45 0.0))<br />   (setq a2 (list '(560.248 748.043 0.0) '(812.045 748.043 0.0) '(812.045 503.352 0.0) '(560.248 503.352 0.0)))<br />   (setq tf (ER_point-in-poly a1 a2))<br />   (princ "\n答案：")<br />   (princ tf)<br />   (princ)<br />   )<br /> <br /> (defun ER_point-in-poly(xpt xdb / fhz mxb myb n i mx my nn p1 p2 p12 pxy a_line xpt1)<br />     (vl-load-com)<br />     (setq fhz 0<br />           mxb nil<br />           myb nil<br />           n   (length xdb)<br />           i   0<br />           xdb (append xdb (list (car xdb)))<br />     )<br />     ;;(setq xpt1 (vlax-make-safearray vlax-vbdouble '(0 . 2)))<br />         ;;(setq xpt1 (vlax-safearray-fill xpt1 xpt))<br /> <br />   <br /> ; 判断点xpt是否在多边形上<br />     (while(< i n)<br />         (setq acadobject   (vlax-get-acad-object)<br />               acadDocument (vla-get-activeDocument acadobject)<br />               mspace           (vla-get-modelspace acaddocument)<br />         )<br />         (setq p1 (vlax-make-safearray vlax-vbdouble '(0 . 2)))<br />         (setq p1 (vlax-safearray-fill p1 (nth i xdb)))<br />         (setq p2 (vlax-make-safearray vlax-vbdouble '(0 . 2)))<br />         (setq p2 (vlax-safearray-fill p2 (nth (1+ i) xdb)))<br />         (setq a_line (vla-addline mspace p1 p2))<br /> <br />         (vla-put-Color a_line 9)<br />         ;;(setq p1 (nth i xdb) p2 (nth (1+ i) xdb))<br />         ;;(command "line" p1 p2 "" "chprop" (entlast) "" "c" 9 "")<br />         ;;;(princ "\nhhhhhhhhhhhhhhhh")(princ a_line )<br />         (setq p12 (vlax-curve-getclosestpointto a_line xpt1));;;;;这里出现error: bad argument type: 2D/3D point<br /> <br />                 <br />         (entdel a_line)<br />         ;若xpt至某一边的距离为零，则xpt在多边形上，因计算误差，设10的-6次方为与零的比较误差<br />         (if (equal (distance xpt1 p12) 0.0 1e-6) (setq fhz 1 i n))<br />         (setq i (1+ i))<br />     )<br /> (if (/= fhz 1)<br />     ; 判断点xpt是否在多边形内<br />         (progn<br />         (foreach p12 xdb<br />            (setq mxb (append mxb (list (abs (- (car xpt1) (car p12)))))<br />                myb (append myb (list (abs (- (cadr xpt1) (cadr p12)))))<br />            )<br />         )<br />            (setq pxy (mapcar '+ xpt1 (list (* 2.0 (apply 'max mxb)) (apply 'min myb)))<br />           i 0   nn 0<br />            )<br />            (repeat n<br />            (if (inters xpt1 pxy (nth i xdb) (nth (1+ i) xdb)) (setq nn (1+ nn)))<br />            (setq i (1+ i))<br />            )<br />            (if (and (> nn 0) (/= nn (* (fix (/ nn 2.0)) 2.0))) (setq fhz 2))<br />         )<br />     )<br />     (setq fhz fhz)<br /> )<br />   [/FONT]<br />

twoguns

;;;;;;测试程序
(defun c:ccc( / a a2 tf)
  (vl-load-com)
  (setq acadobject (vlax-get-acad-object)
              acadDocument (vla-get-activeDocument acadobject)
              mspace           (vla-get-modelspace acaddocument)
        )
  (setq a1 '(670.759 584.45 0.0))
  (setq a2 (list '(560.248 748.043 0.0) '(812.045 748.043 0.0) '(812.045 503.352 0.0) '(560.248 503.352 0.0)))
  (setq tf (ER_point-in-poly a1 a2))
  (princ "\n答案：")
  (princ tf)
  (princ)
) ;enddefun

(defun ER_point-in-poly (xpt xdb / fhz mxb myb n i mx my nn p1 p2 p12 pxy a_line xpt1)   
  (setq fhz 0 mxb nil myb nil n (length xdb) i 0 xdb (append xdb (list (car xdb))))   
  ; 判断点xpt是否在多边形上
    (while (< i n)        
        (setq p1 (vlax-make-safearray vlax-vbdouble '(0 . 2)))
        (setq p1 (vlax-safearray-fill p1 (nth i xdb)))
        (setq p2 (vlax-make-safearray vlax-vbdouble '(0 . 2)))
        (setq p2 (vlax-safearray-fill p2 (nth (1+ i) xdb)))
        (setq a_line (vla-addline mspace p1 p2))
        (vla-put-Color a_line acred)
        ;;(setq p1 (nth i xdb) p2 (nth (1+ i) xdb))
        ;;(command "line" p1 p2 "" "chprop" (entlast) "" "c" 9 "")
        ;;;(princ "\nhhhhhhhhhhhhhhhh")(princ a_line )
        (setq p12 (vlax-curve-getclosestpointto a_line xpt))        
        ;该处错误
        ;(entdel a_line)
        ;如果要删除对象用下列语句
        ;(vla-delete a_line)
        ;若xpt至某一边的距离为零，则xpt在多边形上，因计算误差，设10的-6次方为与零的比较误差
        (if (equal (distance xpt p12) 0.0 1e-6) (setq fhz 1 i n))
        (setq i (1+ i))
    ) ;endwhile (< i n)
    (if (/= fhz 1)
    ; 判断点xpt是否在多边形内
        (progn
          (foreach p12 xdb (setq mxb (append mxb (list (abs (- (car xpt) (car p12)))))
               myb (append myb (list (abs (- (cadr xpt) (cadr p12)))))
           )
        )
           (setq pxy (mapcar '+ xpt (list (* 2.0 (apply 'max mxb)) (apply 'min myb)))
          i 0   nn 0
           )
           (repeat n
           (if (inters xpt pxy (nth i xdb) (nth (1+ i) xdb)) (setq nn (1+ nn)))
           (setq i (1+ i))
           )
           (if (and (> nn 0) (/= nn (* (fix (/ nn 2.0)) 2.0))) (setq fhz 2))
        )
    )
    (setq fhz fhz)
) ;enddefun