[编程交流] 多边形内部或外部的点

   (defun c:Test (/ p1 p2 gr)
   ;;;;; Tharwat 28. June. 2012 ;;;;;
    (if (and (setq p1 (getpoint "\n Specify point :"))
             (setq p2 (getcorner p1 "\n Corner :"))
        )
      (while (eq (car (setq gr (grread t 15 1))) 5) (redraw)
        (foreach n '((0.5 0.5 0.0) (-0.5 0.5 0.0)(-0.5 -0.5 0.0)(0.5 -0.5 0.0))
          (grdraw
            (cadr gr)
            (mapcar '+ (mapcar (function (lambda (x) (* x (/ (getvar "VIEWSIZE") 25.))))
                (trans n 1 0))
              (cadr gr)
            )
            1
            0
          )
        )
    
        (if
          (and
            (< (car p1) (car (cadr gr)))
            (> (car p2) (car (cadr gr)))
            (> (cadr p1) (cadr (cadr gr)))
            (< (cadr p2) (cadr (cadr gr)))
          )
           (princ "\n inside ...... ")
           (princ "\n outside ..... ")
        )
      )
    )
    (redraw)
    (princ)
   )
    

(defun c:TestPick( / refEntity thePoint )
(setq refEntity (entlast))
(setq thePoint (getpoint "\nPick a point:"))
(command "_BOUNDARY" thePoint "")
(if (equal refEntity (entlast))
 (prompt "\nPicked outside!")
 (progn
  (prompt "\nPicked inside!")
  (entdel (entlast))
 )
)
(princ)
)

[color=GREEN];; Point Inside-p  -  Lee Mac[/color]
[color=GREEN];; Utilises a ray-casting algorithm to determine whether a[/color]
[color=GREEN];; given point (WCS) resides within a supplied object.[/color]
([color=BLUE]defun[/color] LM:PointInside-p ( pt obj [color=BLUE]/[/color] lst ray )
   ([color=BLUE]setq[/color] lst
       ([color=BLUE]vlax-invoke[/color]
           ([color=BLUE]setq[/color] ray
               ([color=BLUE]vla-addray[/color]
                   ([color=BLUE]vla-objectidtoobject[/color] ([color=BLUE]vla-get-document[/color] obj) ([color=BLUE]vla-get-ownerid[/color] obj))
                   ([color=BLUE]vlax-3D-point[/color] pt)
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] pt '(1.0 0.0 0.0)))
               )
           )
           'intersectwith obj [color=BLUE]acextendnone[/color]
       )
   )
   ([color=BLUE]vla-delete[/color] ray)
   ([color=BLUE]=[/color] 1 ([color=BLUE]logand[/color] 1 ([color=BLUE]length[/color] lst)))
)

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] ent obj pnt )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] ent ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect Polyline: "[/color])))
       ([color=BLUE]if[/color] ([color=BLUE]vlax-method-applicable-p[/color] ([color=BLUE]setq[/color] obj ([color=BLUE]vlax-ename->vla-object[/color] ent)) 'intersectwith)
           ([color=BLUE]while[/color] ([color=BLUE]setq[/color] pnt ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick Point: "[/color]))
               ([color=BLUE]if[/color] (LM:PointInside-p ([color=BLUE]trans[/color] pnt 1 0) obj)
                   ([color=BLUE]alert[/color] [color=MAROON]"Point is INSIDE"[/color])
                   ([color=BLUE]alert[/color] [color=MAROON]"Point is OUTSIDE"[/color])
               )
           )
           ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid Object selected."[/color])
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])