### Author Topic: Point Containment Test: Convex and Concave Polygons  (Read 26767 times)

0 Members and 1 Guest are viewing this topic.

#### zoltan

• Guest
##### Point Containment Test: Convex and Concave Polygons
« on: November 23, 2005, 07:43:25 PM »
Taken right out of "Computer Graphics Handbook, Geometry and Mathematics" by Michael E. Mortenson:

Given a test point Pt determine if it is inside, outside, or on the boundary of a polygon (convex or concave). Do this in two steps:
1. Using the polygon vertex points, find the min-max box.
i. If Pt is not inside the min-max box, then it is not inside the polygon.
ii. If Pt is inside, proceed to the next step.

2. Compute the intersection of y=yt with the edges of the polygon. Consider only the edges whose end points straddle yt. Count intersections with a vertex as two.  There are always an even number of intersections.  Pair the x coordinates of the intersections in ascending order; for example, (x1, x2) (x3, x4), and so on. Then:
i. If xt falls inside an interval, for example x1 < xt > x2, then Pt is inside the polygon.
ii. If xt is identically equal to on of the interval limits, then Pt is on the boundary.
iii. Otherwise Pt is outside the polygon.

So I did that:
Code: [Select]
`;;Determines if a point is inside a polygon defined by an ordered list of points.;;Return 1 if point is inside the boundary, 2 if it is on the boundary and nil otherwise.;;Only works for 2D points, if 3D points are supplies, the Caddr is ignored and;;it will give unpredictable results...well, it already gives unpredictable results, so nevermind.(Defun PointInsidePolygonP ( PNT lstPOINTS FUZZ / dXmin dXmax pntXs pntXe pntTest lstTest lstPairs cnt ) (Cond  ((< (Car PNT) (SetQ dXmin (Apply (Function Min) (MapCar (Function Car) lstPOINTS))))   nil  )  ((> (Car PNT) (SetQ dXmax (Apply (Function Max) (MapCar (Function Car) lstPOINTS))))   nil  )  ((< (Cadr PNT) (Apply (Function Min) (MapCar (Function Cadr) lstPOINTS)))   nil  )  ((> (Cadr PNT) (Apply (Function Max) (MapCar (Function Cadr) lstPOINTS)))   nil  )  (T   (SetQ pntXs (List dXmin (Cadr PNT))         pntXe (List dXmax (Cadr PNT))         lstPOINTS (Cons (Car lstPOINTS) (Reverse lstPOINTS)) ;add fisrt point to the front of the revered list         cnt 0   )   (Repeat (1- (Length lstPOINTS))    (If (SetQ pntTest (Inters (Nth cnt lstPOINTS) (Nth (1+ cnt) lstPOINTS) pntXs pntXe)) ;segment intersects test line     (SetQ lstTest (Cons pntTest lstTest) ) ;add it once    )    (SetQ cnt (1+ cnt) )   )   (SetQ lstTest (VL-Sort (MapCar (Function Car) lstTest) (Function <)) ) ;sort list of x coords   (Repeat 2 ;strip duplicates from front and back    (If (Equal (Car lstTest) (Cadr lstTest) FUZZ)     (SetQ lstTest (Cdr lstTest) )    )    (SetQ lstTest (Reverse lstTest) )   )      (While lstTest ;make list of pairs    (SetQ lstPairs (Cons (List (Car lstTest) (Cadr lstTest)) lstPairs) )    (SetQ lstTest (Cddr lstTest) )   )   (SetQ lstPairs (Reverse lstPairs) )   (Cond    ((Or (VL-Member-If (Function (Lambda (l) (Equal (Car PNT) l FUZZ))) (MapCar (Function Car) lstPairs))         (VL-Member-If (Function (Lambda (l) (Equal (Car PNT) l FUZZ))) (MapCar (Function Cadr) lstPairs))     )     2    )    ((VL-Member-If (Function (Lambda (l) (And (> (Car PNT) (Car l)) (< (Car PNT) (Cadr l))))) lstPairs)     1    )    (T     nil    )   )  ) ))(Defun GetPolylinePoints ( POLY / entPoly lstReturn ) (SetQ entPoly (EntGet POLY) ) (SetQ lstReturn (List (Cdr (Assoc 10 entPoly))) ) (While (Assoc 10 (SetQ entPoly (Cdr (Member (Assoc 10 entPoly) entPoly))) )  (SetQ lstReturn (Cons (Cdr (Assoc 10 entPoly)) lstReturn) ) ) (Reverse lstReturn ))(Defun C:TestME ( / ePolyLine pntPick ) (SetQ ePolyLine (Car (EntSel "Pick a Polyline")) ) (SetQ pntPick (GetPoint "Pick a Point") ) (PointInsidePolygonP pntPick (GetPolylinePoints ePolyLine) 0.00001 ))`
At first I had tested to see if the line straddles the test line like this:
Code: [Select]
`(And (Or (And (< (Cadr (Nth cnt lstPOINTS)) (Cadr PNT))                      (> (Cadr (Nth (1+ cnt) lstPOINTS)) (Cadr PNT) )                 )                 (And (> (Cadr (Nth cnt lstPOINTS)) (Cadr PNT))                      (< (Cadr (Nth (1+ cnt) lstPOINTS)) (Cadr PNT) )                 )             ) ;segment straddles test line             (SetQ pntTest (Inters (Nth cnt lstPOINTS) (Nth (1+ cnt) lstPOINTS) pntXs pntXe) ) ;segment intersects test line        ))`..but it was throwing out points when the test line intersected a vertex, so I threw it out. Then I had it determine if the test point was on one of the vetices like this:
Code: [Select]
`     (If (Or (Equal pntTest (Nth cnt lstPOINTS) FUZZ)             (Equal pntTest (Nth (1+ cnt) lstPOINTS) FUZZ)         ) ;test point is on a vertex      (SetQ lstTest (Cons pntTest lstTest) ;add it twice            lstTest (Cons pntTest lstTest)      )      (SetQ lstTest (Cons pntTest lstTest) ) ;add it once     )`...but the intersection of the two line segments at the vertex were returning two points already, so I threw that out also.

Now here is the problem: if the test line intersects a vertex of the polygon, it adds two points to lstTest. However, if the vertex is on a boudary between an area that is in and an area that is out, it needs to be only one point.  At first I thaught to strip the pairs that occur at the start and the end of the test line, but that is not nessicarilly valid either.  here are some examples:

should be two points

should be one point

should be two points

Basically, if both line segments are on one side of the test line then it should be two points, otherwise it should be one.  This would probably get ugly it the polygon went horizontal for a while and one segment was colinear with the test line.

..Any ideas?

(also, on a side note: this is my first post, I finally found this place after walking around in the wilderness for months after Cadvault died.  I'm very glad to be here.  this type of forum is very important to me and I appreciate all of you.  I have taken a few days to look around and get familliar with the swamp and I've already  seen some names I recognize.  It's good to be back.

On with the LiSPing!!)

#### MickD

• King Gator
• Posts: 3688
• (x-in)->[process]->(y-out) ... simples!
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #1 on: November 23, 2005, 08:37:23 PM »
Hi zoltan, welcome aboard!
Have you thought about using halfspaces?
using the parametric equation of a line you can determine whether the point is inside/outside/on the boundary dividing the space in 2d
Ax + By + C = 0

>0 = inside
<0 = outside
==0 = on the line
Aftr the bb test, this is a quick way to determine if the point is in, out or on the line at the first edge. This requres the edges are iterated in a clockwise fashion so that 'inside' is always to the correct side of the polyline.

Now, the hard part is working out what A,B and C are Once you know those you can simply plug in the x and y coord's and your done.

I didn't get to study linear algebra untill recently so I'm a bit stuck with that, maybe someone here may be able to help out.
"Programming is really just the mundane aspect of expressing a solution to a problem."
- John Carmack

"Everything that is possible demands to exist"
- Gottfried Wilhelm von Leibniz

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #2 on: November 23, 2005, 09:13:43 PM »
This may help ... if the points are ordered counter-clockwise, negative is outside

Code: [Select]
`;;;------------------------------------------------------------------;;;------------------------------------------------------------------;;;;;; (k:whichside < ray-origin > < point-on-ray > < point-to-be-tested >);;; return values:;;; negative = point is to the right side of the ray;;; 0 = point is on the ray;;; otherwise point is on the left side of the ray(defun k:whichside (p1 p2 pt / s)  (setq s (cond ((equal p1 pt 1e-14) 0.0)                (t (sin (- (angle p1 pt) (angle p1 p2))))          )  )  (if (equal s 0.0 1e-14)    0.0    s  )`
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

#### MickD

• King Gator
• Posts: 3688
• (x-in)->[process]->(y-out) ... simples!
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #3 on: November 23, 2005, 09:19:01 PM »
heh, that'll do it too. I'm no lisp'er but I can see what's going on. Nice simple solution Kerry.
"Programming is really just the mundane aspect of expressing a solution to a problem."
- John Carmack

"Everything that is possible demands to exist"
- Gottfried Wilhelm von Leibniz

#### zoltan

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #4 on: November 23, 2005, 09:36:43 PM »
Unfortunatelly this will only work if the polygon is convex.  Look at the image, starting at the point with the greatest Y value and working counter-clockwide, my cursure in the first image is on the RIGHT side of the 5th segment and still inside.

#### MickD

• King Gator
• Posts: 3688
• (x-in)->[process]->(y-out) ... simples!
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #5 on: November 23, 2005, 09:49:30 PM »
Then half spaces is the way to go, if you combine all the halfspaces together cropping each other on the way you will be left with a 'region' of points that are either in, on or outside regardless of shape. example pictures

Have a look here for how to determine the equation (I just had an 'aha' moment once I read it).

It's a similar form for planes also to work out if a point is contained inside a volume/solid -> Ax + By + Cz = D where ABC are the components of the plane normal vector.
"Programming is really just the mundane aspect of expressing a solution to a problem."
- John Carmack

"Everything that is possible demands to exist"
- Gottfried Wilhelm von Leibniz

#### LE

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #6 on: November 23, 2005, 10:30:43 PM »
Do not want to take the fun.... instead I will provide a defun .... made by John F. Uhden, like two moons ago....

Code: [Select]
`(defun @Inside (PIQ Object / ClosestPoint ClosestParam Sample                             Start End P1 P2 P a1 a2 Defl)  ;;               "LOOK, MA... NO RAYS!"  ;; @Inside.lsp v1.0 (09-15-03) John F. Uhden, Cadlantic.  ;; v2.0 Revised (09-17-03) - See notes below.  ;; Function to determine whether a point is inside the boundary  ;; of a closed curve.  ;; It employs the theorem that the sum of the deflections of a  ;; point inside the curve should equal 360°, and if outside 0°  ;; (both absolute values).  ;; The results with Ellipses were fairly rough, and the results  ;; with a Spline were very rough, thus the fuzz factor of 2.  ;;  ;; Arguments:  ;;   PIQ    - Point to test (2D or 3D point as a list in UCS)  ;;   Object - Curve to test (Ename or VLA-Object)  ;;  ;; Returns:  ;;   T   (if the PIQ is inside the curve)  ;;   nil (if either the arguments are invalid,  ;;       or the PIQ is on or outside the curve)  ;;  ;; NOTES:  ;;   Requires one or another version of the @delta function,  ;;     such as included here.  ;;   It will not work well with self-intersecting (overlapping)  ;;     bulged polyline segments.  ;;   Curves can be CIRCLEs, ELLIPSEs, LWPOLYLINEs, POLYLINES,  ;;     SPLINEs, and maybe even more.  ;;   Thanks already to Doug Broad for finding bugs.  (setq Sample 0.2) ; this is better for bulged polylines.  ;;   Sure, you could decrease the sampling from 0.5 to say 0.1,  ;;     but it will only slow down the process and still not  ;;     guarantee success with overlapping bulged segments.  ;;   DO NOT change the sampling value to anything that is  ;;     greater than 1 or not evenly divisible into 1, as you  ;;     would not be sampling vertices.  ;;   (09-17-03) Found that cusps brought back inside the figure  ;;     yield a total deflection of (* pi 2), so changed evaluation  ;;     to see if deflection was greater than 4, which is  ;;     equivalent to a fuzz factor of 2.28 from (* pi 2).  (vl-load-com)  (or (= (type @delta) 'SUBR)    (defun @delta (a1 a2)      (cond        ((> a1 (+ a2 pi))          (+ a2 pi pi (- a1))        )        ((> a2 (+ a1 pi))          (- a2 a1 pi pi)        )        (1 (- a2 a1))      )    )  )  (and    (cond      ((not Object)        (prompt "  No object provided.")      )      ((= (type Object) 'VLA-Object))      ((= (type Object) 'Ename)        (setq Object (vlax-ename->vla-object Object))      )      (1 (prompt "  Improper object type."))    )    (or      (and        (< 1 (vl-list-length PIQ) 4)        (vl-every 'numberp PIQ)      )      (prompt " Improper point value.")    )    (or      (not        (vl-catch-all-error-p          (setq Start            (vl-catch-all-apply              'vlax-curve-getStartPoint              (list Object)            )          )        )      )      (prompt "  Object is not a curve.")    )    (or      (equal Start (vlax-curve-getendpoint Object) 1e-10)      (prompt "  Curve is not closed.")    )    (setq P (trans PIQ 1 0)) ; PIQ in WCS    (setq ClosestPoint      (vlax-curve-getclosestpointto Object P) ; In WCS    )    (not (equal P ClosestPoint 1e-10)) ; in WCS    (setq ClosestParam (vlax-curve-getparamatpoint Object ClosestPoint))    (setq ClosestPoint (trans ClosestPoint 0 1)) ; convert to UCS    (setq End (vlax-curve-getEndparam Object))    (setq P1 0.0 P2 Sample Defl 0.0)    (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS    (while (<= P2 End)      (setq P2 (min P2 End))      ;; This little extra makes sure not to skip an angle      ;; that might throw off the total deflection.      ;; Moved to near top of while loop in case ClosestParam      ;; is less than the first sample.      (if (< P1 ClosestParam P2)        (setq a2 (angle PIQ ClosestPoint)              Defl (+ Defl (@delta a1 a2))              a1 a2        )      )      ;; The following (while) loop takes care of      ;; coincident adjacent vertices.      (while (not (setq P (vlax-curve-getPointAtParam Object P2)))        (setq P2 (+ P2 Sample))      )      (setq a2 (angle PIQ (trans P 0 1)) ; in UCS          Defl (+ Defl (@delta a1 a2))          a1 a2          P1 P2          P2 (+ P2 Sample)      )    )    ;(print Defl) ; Optional display of results    (> (abs Defl) 4)  ))(defun C:ITest ( / Object P)  (if (setq Object (car (entsel "\nSelect curve: ")))    (while (setq P (getpoint "\nPoint: "))      (prin1 (@Inside P Object))    )  )  (princ))`

#### LE

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #7 on: November 23, 2005, 10:41:21 PM »
Here is a test I did on those days too.... it is very mickey-mouse solution.... just to post it....

Code: [Select]
`;;; 9/4/03 by Luis Esquivel(defun point-inside-region-p       (vla_poly pt aid-pt pts / vla_line lst_value param result)  (setq    result     (if       (and (not (vl-position (list (car pt) (cadr pt)) pts))     (not       (vl-catch-all-error-p (setq lst_value        (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value (vla-intersectwith    vla_poly    (setq vla_line   (vla-addline     (vla-objectidtoobject       (vla-get-document vla_poly)       (vla-get-ownerid vla_poly))     (vlax-3d-point pt)     (vlax-3d-point aid-pt)))    acextendnone)))))))) (fix (/ (length lst_value) 3.0))))  (vl-catch-all-apply 'vla-delete (list vla_line))  (if (and (setq param (vlax-curve-getparamatpoint vla_poly pt))    (eq (type (- param (fix param))) 'real))    (setq result nil))  result)(defun C:TEST  (/ ent elst pt vla_poly lc uc flag)  (if    (and (setq ent (car (entsel "\nSelect a polyline: "))) (eq (cdadr (setq elst (entget ent))) "LWPOLYLINE") (eq (vla-get-closed        (setq vla_poly (vlax-ename->vla-object ent)))      :vlax-true) (setq pt (getpoint "\nTest point: ")))     (progn       (vla-getboundingbox vla_poly 'lc 'uc)       (if (setq      flag       (point-inside-region-p vla_poly pt (polar pt        (/ pi 2.0)        (distance (vlax-safearray->list lc) (vlax-safearray->list uc))) (mapcar   'cdr   (vl-remove-if-not     (function (lambda (item) (eq (car item) 10)))     elst)))) (not (zerop (rem flag 2)))))))(princ)`

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #8 on: November 23, 2005, 11:13:27 PM »
I use a solution similar to Luis's 'Mickey Mouse' one :-
Code: [Select]
`(defun c:test ( / ANGLESTEP INSIDE MSPACE OPLINE ORAY OTESTPOINT TESTPOINT TMP)  (setq mspace    (vla-get-modelspace                    (vla-get-activedocument (vlax-get-acad-object))                  )        oPline    (vlax-ename->vla-object (car (entsel "\nSelect LWPolyline")))        TestPoint (getpoint "\nSpecify Test Point")  )  (setq    anglestep 0    inside 0    oTestPoint     (vlax-3d-point TestPoint)  )  (repeat 24    (setq anglestep (+ 15 anglestep))    (if      (= 0         (rem (vlax-safearray-get-u-bound                (vlax-variant-value                  (setq tmp (vla-intersectwith                              oPline                              (setq                                oRay (vla-addray                                       mspace                                       oTestPoint                                       (vlax-3d-point                                         (polar TestPoint                                                (* pi (/ anglestep 180.0))                                                100                                         )                                       )                                     )                              )                              acExtendNone                            )                  )                )                1              )              2         )      )       (setq inside (1+ inside))       ;; else       (setq inside (1- inside))    )    (vla-delete oRay)      )  (if (minusp inside)    (alert " Point is outside")    (alert " Point is inside")  ))`
« Last Edit: November 23, 2005, 11:24:16 PM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #9 on: November 23, 2005, 11:28:48 PM »
Hi Zoltan,
This is based on the theory that a ray from the 'point' inside the shape will pass through the boundary an odd number of times.

The repeats are in case the point is on a vertex or segment, or if the ray is linear with a segment.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #10 on: November 24, 2005, 12:42:13 AM »
.. and just to cover some bases :-

The posted code makes some assumptions about UCS's and ECS's and Spaces and Closed Polylines and errors
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

#### zoltan

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #11 on: November 24, 2005, 02:25:51 AM »
I'm going to have to look at these with fresh eyes tomorrow. See you in the morning.

#### hudster

• Gator
• Posts: 2848
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #12 on: November 24, 2005, 03:28:32 AM »
Revit BDS 2017, 2016, 2015, 2014, AutoCAD 2017, 2016, Navisworks 2017, 2016, BIM360 Glue

#### Kerry

• Mesozoic relic
• Seagull
• Posts: 11654
• class keyThumper<T>:ILazy<T>
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #13 on: November 24, 2005, 04:05:07 AM »
Thinking further on this, I'd be interested in seeing a pure math based solution not requiring interaction with the database < as such>
.. so Zoltan's original methodology may have to be revisited < and translated, please >

... so we wouldn't want to consider bulges .. yes ?

« Last Edit: November 24, 2005, 04:12:43 AM by Kerry Brown »
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

#### Joe Burke

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #14 on: November 24, 2005, 04:49:55 AM »
Just my two cents regarding what Luis posted by John Uhden. Notice Doug Broad is
mentioned in John's comments. In fact they both worked on the problem and
developed independant solutions.

John and Doug are smart guys and first class programmers. Why reinvent the
wheel?

BTW, John had a reason for abandoning the ray method. I don't recall exactly
what it was. Hence his comment, "LOOK, MA'... NO RAYS!"

Luis, I'm pretty sure this is the final version. Note the function name is not
the same and the version numbers.

Code: [Select]
`(defun @cv_inside (PIQ Object Draw / IsPolyline Closest Start End Param P ClosestParam                                     NextParam a1 a2 Defl @2D @Insect @Bulge @Deflect                                     @Closest Color)  ;;               "LOOK, MA'... NO RAYS!"  ;; @Inside.lsp v1.0 (09-15-03) John F. Uhden, Cadlantic.  ;; v2.0 Revised (09-17-03) - See notes below.  ;; v3.0 Revised (09-20-03) - See notes below.  ;; v4.0 Revised (09-20-04) but still missing something  ;; v5.0 Revised (04-04-04) - See notes below.  ;; Function to determine whether a point is inside the boundary  ;; of a closed curve.  ;; It employs the theorem that the sum of the deflections of a  ;; point inside the curve should equal 360°, and if outside 0°  ;; (both absolute values).  ;;  ;; Arguments:  ;;   PIQ    - Point to test (2D or 3D point as a list in UCS)  ;;   Object - Curve to test (Ename or VLA-Object)  ;;   Draw   - Option to draw vectors to sample points, nil or non-nil  ;;  ;; Returns:  ;;   T   (if the PIQ is inside the curve)  ;;   nil (if either the arguments are invalid,  ;;       or the PIQ is on or outside the curve)  ;;  ;; NOTES:  ;;   Requires one or another version of the @delta function,  ;;     such as included here.  ;;   It will not work well with self-intersecting (overlapping)  ;;     bulged polyline segments.  ;;   Curves can be CIRCLEs, ELLIPSEs, LWPOLYLINEs, POLYLINES,  ;;     SPLINEs, and maybe even more.  ;;   Since all the calulations are based on angles relative to the  ;;     current UCS, there shouldn't be any limitation caused by differences  ;;     in elevation, but it is not suited for abnormal extrusion directions.  ;;   (09-17-03) Found that cusps brought back inside the figure  ;;     yield a total deflection of (* pi 2), so changed evaluation  ;;     to see if deflection was greater than 4, which is  ;;     equivalent to a fuzz factor of 2.28 from (* pi 2).  ;;   (09-20-03) Found that bulged polyline segments needed special  ;;     attention to determine the closest point to any segment because  ;;     it might not be the closest point to the object, but must be  ;;     evaluated to sample sufficient points.  ;;   (04-04-04) Renamed to original @cv_Inside.lsp (c. 2002)  ;;     Remembered there was an issue with splines, so included is a  ;;     Closest evaluation, and a small sample increment, Though I still  ;;     don't trust the results when the PIQ is near a sharp curve.  If splines  ;;     important then make the sample rate tighter at the expense of speed.  ;;     For polylines, the sample increment just 1.0 as there is a special  ;;     subfunction to pick up the midpoint and closest point of bulged segments.  ;;     For objects such as circles and ellipses the sample increment should be  ;;     a multiple of pi to achieve a total deflection that is a multiple of pi  ;;     with in a small fuzz factor.  ;;     Yes, circles and ellipses can be evaluated more easily by a simple  ;;     comparison of distances to their center, but this function is  ;;     intended to treat them as just another curve and to demonstrate  ;;     the method of using curve parameters and deflections.  (vl-load-com)  ;; Subunction to determine the deflection angle in radians beween two given angles  (or (= (type @delta) 'SUBR)    (defun @delta (a1 a2)      (cond        ((> a1 (+ a2 pi))          (+ a2 pi pi (- a1))        )        ((> a2 (+ a1 pi))          (- a2 a1 pi pi)        )        (1 (- a2 a1))      )    )  )  ;; Subfunction to convert a 3D point into 2D for the purpose  ;; of ignoring the Z value.  ;; Added (09-20-03)  (defun @2D (p)(list (car p)(cadr p)))  ;;--------------------------------------------------------  ;; Subfunction to determine if an angle is with the sector  ;; defined by two other angles.  (defun @Insect (Ang Ba Ea)    (if (> Ba Ea)      (cond        ((>= Ang Ba))        ((<= Ang Ea))        (1 nil)      )      (< Ba Ang Ea)    )  )  ;; Subfunction to find the closest point to an object from a given point,  ;; adjusted for elevation differences.  Input and output are in UCS  (defun @Closest (P / P1 P2)    (setq P (trans P 1 0)          P2 P    )    (while (not (equal P1 P2 1e-10))      (setq P1 P2            P2 (vlax-curve-GetClosestPointTo Object P)            P (list (car P)(cadr P)(last P2))      )    )    (trans P2 0 1)  )  ;; Subfunction to emulate the GetBulge method, which can be used only  ;; for simple polylines, not for fit-curved or splined.  ;; Its dual purpose here is to find a point on a bulged segment closest to  ;; the PIQ if it is within the bulge's sector and/or the midpoint of  ;; the bulged segment, and to compute deflections to same in ascending  ;; parameter order.  (defun @Bulge (Param / V1 V2 P1 P2 Center Ba Ea Ma MidParam Delta Radius Swap Ang P)    (and ;; once again the Koster approach      (< Param End)      (setq Param (fix Param))      (setq MidParam (+ Param 0.5))      (setq V1 (vlax-curve-getpointatparam Object Param))      (setq V2 (vlax-curve-getpointatparam Object MidParam))      (setq Ba (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object Param)))))      (setq Ea (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object MidParam)))))      (not (equal Ba Ea 1e-8))      (setq P1 (polar V1 Ba 1.0))      (setq P2 (polar V2 Ea 1.0))      (setq Center (inters V1 P1 V2 P2 nil))      (setq Radius (distance Center V1))      (setq Ba (angle Center V1)) ; Beginning angle      (setq V2 (vlax-curve-getpointatparam Object (1+ Param)))      (setq Ea (angle Center V2)) ; End angle      (setq Ma (angle Center (vlax-curve-getpointatparam Object MidParam))) ; Mid angle      (setq MidP (trans (vlax-curve-GetPointAtParam Object MidParam) 0 1))      ;; Since we don't have the value of bulge, and since the internal angle (Delta)      ;; can be > pi, cut the segment in half and add up the separate deflections:      (setq Delta (+ (@delta Ba Ma)(@delta Ma Ea)))      ;; If you had a Tan function, then you could      ;; (setq Bulge (Tan (/ Delta 4)))      (or        (> Delta 0)        (setq Swap Ba Ba Ea Ea Swap)      )      (setq Ang (angle Center (trans PIQ 1 0)))      (if (@Insect Ang Ba Ea)        (setq P (trans (polar Center Ang Radius) 0 1)              P (@Closest P)              PParam (vlax-curve-GetParamAtPoint Object (trans P 1 0))        )      )      (cond        ((or (not PParam)(= PParam MidParam))          (@Deflect MidP 3) ; in UCS        )        ((< PParam MidParam)          (@Deflect P 1) ; in UCS          (@Deflect MidP 3) ; in UCS        )        ((> PParam MidParam)          (@Deflect MidP 3) ; in UCS          (@Deflect P 1) ; in UCS        )      )    )  )  (defun @Deflect (P Color)    (setq a2   (angle PIQ P) ; in UCS          Defl (+ Defl (@delta a1 a2))          a1 a2    )    (if Draw (grdraw PIQ P Color))  )  ;;=========================================================  ;; Begin input validation and processing using the  ;; Steph(and) Koster approach which simply stops evaluating  ;; on any nil result:  (and    ;; Validate input object:    (cond      ((not Object)        (prompt "  No object provided.")      )      ((= (type Object) 'VLA-Object))      ((= (type Object) 'Ename)        (setq Object (vlax-ename->vla-object Object))      )      (1 (prompt "  Improper object type."))    )    ;; Validate input point:    (or      (and        (< 1 (vl-list-length PIQ) 4)        (vl-every 'numberp PIQ)      )      (prompt " Improper point value.")    )    ;; Validate that object is a curve:    (or      (not        (vl-catch-all-error-p          (setq Start            (vl-catch-all-apply              'vlax-curve-getStartPoint              (list Object)            )          )        )      )      (prompt "  Object is not a curve.")    )    ;; Validate that curve is closed:    (or      (equal Start (vlax-curve-getendpoint Object) 1e-10)      (prompt "  Curve is not closed.")    )    (setq Closest (@Closest PIQ)) ; in UCS    ;; Test to see if PIQ is on object:    (not (equal (@2D PIQ)(@2D Closest) 1e-10)) ; in WCS    (setq ClosestParam (vlax-curve-getparamatpoint Object (trans Closest 1 0)))    (or (not Draw)(not (grdraw PIQ Closest 2)))    (setq IsPolyline (wcmatch (vla-get-objectname Object) "*Polyline")          End (vlax-curve-getEndparam Object)    )    ;; Set the sample rates based on object type and end parameter.    (cond      (IsPolyline        (setq ClosestParam nil)        (setq Sample 1.0)      )      ((equal (rem End pi) 0.0 1e-10)        (setq Sample (* pi 0.2))      )      ((setq Sample (* End 0.01)))    )    ;; Initialize the values to be incremented and computed:    (setq Param Sample Defl 0.0)    (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS    ;; Iterate through the object by parameter:    (while (<= Param End)      (setq Param (min Param End))      ;; This little extra makes sure not to skip an angle      ;; that might throw off the total deflection.      ;; It is at the top of while loop in case ClosestParam      ;; is less than the first sample.      ;; This is not to be used with polylines.      (if (and ClosestParam (> Param ClosestParam))        (setq P Closest              ClosestParam nil              NextParam Param              Color 2        )        (setq P (trans (vlax-curve-getpointatparam Object Param) 0 1)              NextParam (+ Param Sample)              Color 3        )      )      (@Deflect P Color) ; in UCS      ;; For polylines check for additional points on any      ;; bulged segment.      (if IsPolyline (@Bulge Param))      (setq Param NextParam)    )    (if Draw (print Defl)) ; Optional display of results    (> (abs Defl) 4) ; to allow for rough calculations if                     ; sample rates are too high (large).  ));; Testing command function:(defun C:ITest ( / Object P)  (redraw)  (if (setq Object (car (entsel "\nSelect curve: ")))    (while (setq P (getpoint "\nPoint: "))      (redraw)      (prin1 (@cv_inside P Object 1))    )  )  (princ))`

#### zoltan

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #15 on: November 24, 2005, 09:25:49 AM »
My original notion for this was to process a list of points and not have to get or create any real objects.  Kerry, your solution with the rays is interesting because it is essentially the same as my code where the ray is one half of my pntXs to pntXe test line.  I could have tested a line from PNT to pntXs  or pntXe and it would always be odd if the point was inside and even if the point was outside.  But you would still come upon my current problem if your ray crossed a vertex.

Joe, I will give your code by Luis and John a good looking-at.  Since ultimately when I use this function I will be getting the points by exploding a temporary copy of a REGION into lines and then erasing the lines, if your code will opperate on the region directly (edit: nevermind, it won't), it would be a better solution.  The interesting thing about that function is that it almost behaves correctly when the curve is self-intersecting.  I finds all of the insides but thinks that some of the nested outside are inside also. It's definatelly a keeper, though.

Take a covex, closed polyline with alot of points and hatch it with an associative hatch by selecting the object instead of picking a point.  Then twist it up by moving the vertices around.  The hatch will update and should always be valid by alternating inside/outside for any nested shapes.  Joe's function finds most of these correctly.

I am still going to work on my quirky code above to have a nice library function that is universal. The method it uses is probably pretty standard, since it is in a book about computer graphics algorithms.  So let me explain my ugly code a little bit:

The function asks for PNT as a point defined by a List of two or three Reals and lstPOINTS as a list of lists of two or three reals, kinda like the GetPolylinePoints function returns.  It also asks for a FUZZ which is given to the Equal function as the fuzz factor.
The first for conditions determin if the point is outside the min-max bounding box in each direction and it also establishes dXmin and dxMax as the min and max X coordinates for my test line. d stands for Decimal and it lets me know that they are Reals. (I'm Hungarian so Hungarian Notation holds a special place in my heart, and it's very well suited for LiSP).
If none of those conditions are true then we go on to the step 2 as described in the book.  I set up pntXs and pntXe as the start and end points of my test line.  I will eventually re-write this to eliminate the Inters function and test the intsection of an infinite line with the segments, but that code is about half done.  here I also add the first element in the list of points to the end of the list to make it a loop, so when I step through the length of the original list with the (Nth cnt ...) and (Nth (1+ cnt) ...) the last point will be the same as the fist to close the polygon.
Now I loop through the length of the original list (1- (Length ...)) and test every segment to see if it intersects my X test line.  If it does I Cons it to lstTest. Then I strip out all of the x coordinates and arrange them in ascending order by MapCar-ing the Car function thru the list and giving it to VL-Sort.
The next portion where I strip the duplicates from the front and end of the list is a result of my BFI coding and should be ignored before it embarrasses me!
Next I make a list of pairs of points, lstPairs by Constructins a List of the Car and Cadr of the list and dropping the first two elements with Cddr and looping until the original list is nil.  I only do this to make MapCar-ing through the list to test the pairs easier then looping the elements of the first list two at a time.
The list is backwards, so I reverse it.  The list looks like this ((x1 x2) (x3 x4) ...).  The next Cond determines the result.
If the Car of PNT Equals either the Car of one of the elements of lstPairs or the Cadr of one of the elements, then the test point is on the boundary of the polygon.
If the Car of PNT false between on of the pair so that x1 < xt > x2, than the point is on the inside.
Otherwise, the last T condition returns nil and the point is on the outside.
« Last Edit: November 24, 2005, 10:20:00 AM by zoltan »

#### LE

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #16 on: November 24, 2005, 10:15:35 AM »
Thinking further on this, I'd be interested in seeing a pure math based solution not requiring interaction with the database < as such>
... so we wouldn't want to consider bulges .. yes ?

I do not think it could be possible to do it in plain auto/visual lisp, I might be wrong, but I have tried before.... and no luck.

In my new functions for gbpoly16.arx I am including "PtInsPol" that I am using to find if a point is inside of a polyline [any shape]... the idea is to use it as a better alternative to highlight polylines when passing the cursor on top of them, but to work with the ones that are in the center of other ones and not required to even touch the polylines.....

#### zoltan

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #17 on: November 24, 2005, 10:24:54 AM »
It is possible for polygons with streight line edges.  Polylines with arcs and splines would take some nasty mathematics that probably should not be done in lisp.

#### zoltan

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #18 on: November 24, 2005, 10:56:37 AM »
ok...Here is a Kludgy solution:
Code: [Select]
`(If (SetQ pntTest (Inters (Nth cnt lstPOINTS) (Nth (1+ cnt) lstPOINTS) pntXs pntXe) ) ;segment intersects test line     (Cond      ((And (Equal pntTest (Nth cnt lstPOINTS) FUZZ)            (Or (And (> (Cadr (Nth (1+ cnt) lstPOINTS)) (Cadr pntTest))                     (< (Cadr (Nth (1- cnt) lstPOINTS)) (Cadr pntTest))                )                (And (> (Cadr (Nth (1+ cnt) lstPOINTS)) (Cadr pntTest))                     (< (Cadr (Nth (1- cnt) lstPOINTS)) (Cadr pntTest))                )            )            (Not bVertHit )       )       (SetQ bVertHit T )      )      ((And (Equal pntTest (Nth (1+ cnt) lstPOINTS) FUZZ)            (Or (And (> (Cadr (Nth cnt lstPOINTS)) (Cadr pntTest))                     (< (Cadr (Nth (+ cnt 2) lstPOINTS)) (Cadr pntTest))                )                (And (> (Cadr (Nth cnt lstPOINTS)) (Cadr pntTest))                     (< (Cadr (Nth (+ cnt 2) lstPOINTS)) (Cadr pntTest))                )            )            (Not bVertHit )       )       (SetQ bVertHit T )      )      (T       (SetQ lstTest (Cons pntTest lstTest) )       (SetQ bVertHit nil )      )     )    )`
This is going on the idea that if the two segments are on the same side of the test line then the vertex has to represent to points.  If the intersection point is one of the vertices, it sets a flag and drops the point if the two vertices are on oposite sides of the test line. If the flag is already set when it hits the vetex of the next segment, it does not drop the point and resets the flag.

BFI: dumb, but simple.  Now I need to see how bad it will puke if the segment is horizontal and colinear with the test line.

#### Joe Burke

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #19 on: November 26, 2005, 07:49:26 AM »
zoltan,

Surely I don't understand everything you said.

I'll just underline the fact John's comments mention, "It will not work well with self-intersecting (overlapping) bulged polyline segments."

#### MP

• Seagull
• Posts: 17750
• Have thousands of dwgs to process? Contact me.
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #20 on: November 26, 2005, 01:37:29 PM »
I can't contribute anything useful to this thread, but as first posts go this is quite an entrance!

Welcome to the swamp Zoltan.

Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client

#### chlh_jd

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #21 on: March 27, 2011, 04:56:18 PM »
hi All , just see this site .
here's my method .
Code: [Select]
`(defun pt-in-region (pt pts Acc / ss-member-pts pt1 ptn p at)  ;;judge a point is in the 2D polygon , polygon given with vetexs .  ;;by GSLS(SS) 2011.03.28  ;;return 0 at polygon, 1 in it, -1 out it .  (defun ss-member-pts (pt ptl acc / is_go i len a b)    (setq is_go T i 0  len(length ptl))    (while (and is_go (< i len))      (setq a(car ptl)ptl(cdr ptl)i(1+ i))      (if (and a (equal a pt acc)) (setq is_go nil  b (cons a ptl)))))  (setq pt1(list (+ (car (apply (function mapcar) (cons (function max) pts)))(abs acc)(abs acc))(cadr pt)))    (mapcar(function(lambda (x y)     (if(setq p (inters pt pt1 x y T))       (progn (if(equal (+(distance pt x)(distance pt y))(distance x y)acc)(setq at T)) (if(not (ss-member-pts p pts acc)) (setq ptn (cons p ptn))))))) (cons (last pts) pts) pts)  (cond (at 0) ((and (not at) ptn) (if (= (rem (length ptn) 2) 1)    1  -1 )) (t -1)  ));;(defun c:test (/ ss-assoc pts pt is)  (defun ss-assoc (a lst / b lst2)    (while (setq b (assoc a lst))      (setq lst (cdr (member b lst))     lst2 (cons (cdr b) lst2)      ))    (reverse lst2)  )  (setq pts (ss-assoc 10 (entget (car (entsel "Select a polyline :")))))  (while (setq pt (getpoint))    (setq is (pt-in-region pt pts 1e-8))    (cond ((= is -1) (alert "Out ."))   ((= is 0) (alert "At ."))   ((= is 1) (alert "In ."))   )      )  (princ))`

#### efernal

• Bull Frog
• Posts: 206
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #22 on: March 27, 2011, 06:12:18 PM »
e.fernal

#### chlh_jd

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #23 on: March 28, 2011, 02:24:20 AM »
Thanks efernal ,
it's new
Code: [Select]
`(defun pt-in-polygon (pt pts Eps / minpt maxpt pt1 ptn p at)  ;;judge a point is in the 2D polygon , polygon given with vetexs .  ;;by GSLS(SS) 2011.03.28  ;;return 0 at polygon, 1 in it, -1 out it .  (setq minpt (apply (function mapcar)(cons(function min)pts)) maxpt (apply (function mapcar)(cons(function max)pts)) Eps (abs Eps))  (if (or(<(cadr pt)(- (cadr minpt)Eps))(<(+(cadr maxpt)Eps)(cadr pt)) (< (car pt)(-(car minpt)Eps))(<(+(car maxpt)Eps)(car pt)))    -1    (progn      (setq pt1(list(+(car maxpt)Eps Eps)(cadr pt)))      (mapcar(function(lambda (x y)     (if(setq p (inters pt pt1 x y T))       (progn (if(equal (+(distance pt x)(distance pt y))(distance x y)Eps)(setq at T)) (if(not (ss-member-pts p pts Eps)) (setq ptn (cons p ptn))))))) (cons (last pts) pts) pts)      (cond(at 0)((and (not at) ptn)(if (= (rem (length ptn) 2) 1)1 -1))(t -1)))))`

#### KWL

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #24 on: March 28, 2011, 03:22:06 AM »

#### chlh_jd

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #25 on: March 28, 2011, 03:38:23 AM »
Thanks KWL .
Another method
Code: [Select]
`;;;it has a problem : if a point at the given polygon , it perhap return T or NIL .(defun isPtinPM (pt pts)  ;; by 狂刀  Handed Knife  (equal  PI (abs (apply'+(mapcar'(lambda (x y) (rem (- (angle pt x) (angle pt y)) PI)) (cons (last pts) pts) pts)))1e-3))(defun c:test (/ ss-assoc pts pt is)  (defun ss-assoc (a lst / b lst2)    (while (setq b (assoc a lst))      (setq lst (cdr (member b lst))     lst2 (cons (cdr b) lst2)      ))    (reverse lst2)  )  (setq pts (ss-assoc 10 (entget (car (entsel "Select a polyline :")))))  (while (setq pt (getpoint))    (if (isptinpm pt pts)      (alert "In .")      (alert "Out .")      ))     (princ))`

#### chlh_jd

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #26 on: March 28, 2011, 03:54:12 AM »
hi All , a new version .
Code: [Select]
`(defun isPtinPM (pt pts eps / is at)  ;; by 狂刀  Handed Knife  ;; Edit by GSLS(SS) 2011.03.28  ;; Solved the problem : if a point at the given polygon , it perhap return T or NIL .  (setq is(equal PI(abs(apply(function +)(mapcar(function(lambda (x y / a)            (setq a (rem (- (angle pt x) (angle pt y)) PI))        (if (equal a 0.0 eps)(setq at T))a))    (cons (last pts) pts) pts))) eps))  (cond (at 0)(is 1)(T -1)))(defun c:test (/ pts pt is)  (setq pts (ss-assoc 10 (entget (car (entsel "Select a polyline :")))))  (while (setq pt (getpoint "Select point:>"))    (setq is (isPtinPM pt pts 1e-8))    (cond ((= is -1) (alert "Out ."))   ((= is 0) (alert "At ."))   ((= is 1) (alert "In ."))    )  )  (princ))`

#### Q1241274614

• Guest
##### Re: Point Containment Test: Convex and Concave Polygons
« Reply #27 on: March 24, 2014, 08:25:34 AM »
ok
« Last Edit: March 24, 2014, 08:31:53 AM by Q1241274614 »