Test Whether A Point Is In A Polygon Or Not

[Rick Rothstein]

This function is not one that many will find a use for, but if you ever need its functionality, then here it is. The function can be called from other VB code or used as a UDF (user defined function) directly on a worksheet. What it does is tell you whether a point is located inside a polygon (simple or complex, convex or concave) or not. That's it... if you should ever need such a function, this is the code for it...




Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant
Poly = Polygon
If Not (Poly(LBound(Poly), 1) = Poly(UBound(Poly), 1) And _
Poly(LBound(Poly), 2) = Poly(UBound(Poly), 2)) Then
If TypeOf Application.Caller Is Range Then
PtInPoly = "#UnclosedPolygon!"
Else
Err.Raise 998, , "Polygon Does Not Close!"
End If
Exit Function
ElseIf UBound(Poly, 2) - LBound(Poly, 2) <> 1 Then
If TypeOf Application.Caller Is Range Then
PtInPoly = "#WrongNumberOfCoordinates!"
Else
Err.Raise 999, , "Array Has Wrong Number Of Coordinates!"
End If
Exit Function
End If
For x = LBound(Poly) To UBound(Poly) - 1
If Poly(x, 1) > Xcoord Xor Poly(x + 1, 1) > Xcoord Then
m = (Poly(x + 1, 2) - Poly(x, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
b = (Poly(x, 2) * Poly(x + 1, 1) - Poly(x, 1) * Poly(x + 1, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
Next
PtInPoly = CBool(NumSidesCrossed Mod 2)
End Function





The theory behind the function is simplicity itself... start at the point being tested and project a line from that point outward in any direction (I chose straight up as that made some of the math easier) and count how many polygon sides it crosses... if the number of sides is odd, the point lies inside the polygon and if the number of sides is even, the point lies outside of the polygon. The function will return either True, False (for inside/outside respectively) or an error message (see below). The first argument is the X-Coordinate and the second argument is the Y-Coordinate of the point you want to test for being inside the polygon or not. The third argument is either a two-dimensional array of numbers (when called from another VB code procedure) or a range of numbers consisting of two columns and as many rows as needed (when called from a worksheet). The numbers describe the nodes composing the polygon.

NOTE #1: The polygon must be closed, meaning the first listed point and the last listed point must be the same. If they are not the same, the function will raise "Error #998 - Polygon Does Not Close!" if the function was called from other VB code or it will return #UnclosedPolygon! if called from the worksheet. Normally, if called from a worksheet, you would probably be using the function in a formula something like this...

=IF(PtInPoly(B9,C9,E18:F37),"In Polygon","Out Polygon")

In that case, the formula will return a #VALUE! error, not the #UnclosedPolygon! error, because the returned value to the IF function is not a Boolean; however, if you select the "PtInPoly(B9,C9,E18:F37)" part of the function in the Formula Bar and press F9, it will show you the returned value from the PtInPoly function as being #UnclosedPolygon!.

NOTE #2: The range or array specified for the third argument must be two-dimensional. If it is not, then the function will raise "Error #999 - Array Has Wrong Number Of Coordinates!" if the function was called from other VB code or it will return #WrongNumberOfCoordinates! if called from the worksheet. Error reporting when called from the worksheet will be the same as described in NOTE #1.

NOTE #3: Points extremely close to, or theoretically lying on, the polygon borders may or may not report back correctly... the vagrancies of floating point math, coupled with the limitations that the "significant digits limit" in VBA imposes, can rear its ugly head in those circumstances producing values that can calculate to either side of the polygon border being tested (remember, a mathematical line has no thickness, so it does not take too much of a difference in the significant digits to "move" a calculated point's position to one side or the other of such a line).

NOTE #4: While I think error checking is a good thing, the setup for this function is rather straightforward and, with the possible exception of the requirement for the first and last point needing to be the same, easy enough for the programmer to maintain control over during coding. If you feel confident in your ability to meet the needs of NOTE #1 and NOTE #2 without having the code "looking over your shoulder", then the function can be simplified down to this compact code...




Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant
Poly = Polygon
For x = LBound(Poly) To UBound(Poly) - 1
If Poly(x, 1) > Xcoord Xor Poly(x + 1, 1) > Xcoord Then
m = (Poly(x + 1, 2) - Poly(x, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
b = (Poly(x, 2) * Poly(x + 1, 1) - Poly(x, 1) * Poly(x + 1, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
Next
PtInPoly = CBool(NumSidesCrossed Mod 2)
End Function

[Rick Rothstein]

Just replying to this thread to alert people who have looked at this thread previously that I have now included an attachment which will allow you to move a point around a chart showing a polygon using embedded scroll bars... as the point moves in and out of the polygon, a message above the chart shows with the the PtInPoly function thinks the point is inside the polygon or not.

[Excel Fox]

This is so cool. Thanks Rick.

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837 (https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837)
https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836 (https://www.eileenslounge.com/viewtopic.php?f=21&t=40701&p=314836#p314836)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621 (https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314621#p314621)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314619#p314619 (https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314619#p314619)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314600#p314600 (https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314600#p314600)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314599#p314599 (https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314599#p314599)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314274#p314274 (https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314274#p314274)
https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314229#p314229 (https://www.eileenslounge.com/viewtopic.php?f=27&t=40621&p=314229#p314229)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Dan1445]

Hi Rick,

Thank you for posting. Over the last couple weeks, I've been testing sijpie's code about point in polygon, but I discovered quite a few errors. Your code has worked flawlessly thus far.
I had one question about the logic and a possibility to increase speed.
For my task, I loop through 1000's of polygons with anywhere from 10-100 coordinate points in search of the correct pointinpolygon. Is it always necessary to loop through the entire array of polygon coordinates? Would it increase speed to insert a "quit/exit loop" if any of the polygon coordinates does not satisfy the test, or does the logic require all coordinates to be tested? Thanks again!

[Rick Rothstein]

Hi Rick,

Thank you for posting. Over the last couple weeks, I've been testing sijpie's code about point in polygon, but I discovered quite a few errors. Your code has worked flawlessly thus far.
I had one question about the logic and a possibility to increase speed.
For my task, I loop through 1000's of polygons with anywhere from 10-100 coordinate points in search of the correct pointinpolygon. Is it always necessary to loop through the entire array of polygon coordinates? Would it increase speed to insert a "quit/exit loop" if any of the polygon coordinates does not satisfy the test, or does the logic require all coordinates to be tested? Thanks again!
If your polygons were always convex, then yes, there might be a way to speed things up, but only a little bit; however, if not, then no, all polygon sides must be tested as non-convex polygons can get quite intricate in shape.

[eric.carden]

Hi Rick,

Thanks for sharing this solution. I'm working on an Excel-based scoring system for a cross-country hang gliding contest, and one of the things that needs to be checked while scoring is whether the pilot landed in an off-limits "Do Not Land" (DNL) area (like a pasture owned by an unwelcoming farmer). If he did, then he gets a ZERO! I'm working on adding the polygons describing these DNL areas to the scoring system and using the pilot's reported landing coordinates to automatically check whether he landed in a DNL area. Your function should work beautifully. :-)

By the way, I see in the function (both versions of it) the declaration of four variables that aren't used: LB1, LB2, UB1, and UB2.

Thanks again,

Eric

[neal_at_sea]

Thanks this is a really useful function. I am using it to estimate soil type from Cone Penetration Test data. I digitized a xy plot from a scientific paper with 9 zones predicting soil type and created polygons for each of the zones to test where the point lies. It works great.

Currently the geometry of the polygons is referenced by cell values in a work sheet, I was wondering however whether it would be possible to include the polygon geometry in the VBA code, so that I can create a UDF that I can call at any time, without the need to reference back to the polygon xy data in a worksheet?

Thanks
Neal

[Rick Rothstein]

Hi Rick,

By the way, I see in the function (both versions of it) the declaration of four variables that aren't used: LB1, LB2, UB1, and UB2.

Thanks for noting that... I fixed the code in my original article by removing them.

[Rick Rothstein]

Thanks this is a really useful function. I am using it to estimate soil type from Cone Penetration Test data. I digitized a xy plot from a scientific paper with 9 zones predicting soil type and created polygons for each of the zones to test where the point lies. It works great.

Wow, great! I am so glad you made that comment as I often wonder if anyone actually puts any of the stuff I post to practical use.



Currently the geometry of the polygons is referenced by cell values in a work sheet, I was wondering however whether it would be possible to include the polygon geometry in the VBA code, so that I can create a UDF that I can call at any time, without the need to reference back to the polygon xy data in a worksheet?

If I understand you correctly, you have predefined polygons that will not change and you want to bundle their coordinates directly into my function. Rather than do that, I would leave my function as is and create new functions that have the coordinates predefined in them and have that new function call my PtInPoly function passing the predefined array of coordinates to it. Here is an example of what I am thinking using a triangle as the predefined polygon. The triangle coordinates will be (1,2), (9,3) and (4,7). Here is the function I am suggesting you create for this fixed polygon...


Function PtInTriangle(Xcoord As Double, Ycoord As Double) As Boolean

' Remember, the shape must be closed, so there must
' be one array element more than shape corners and
' the first and last coordinates must be the same
Dim Triangle(1 To 4, 1 To 2) As Double

' Define the Triangle
' -------------------
' Xcoords : Ycoords
Triangle(1, 1) = 1: Triangle(1, 2) = 2
Triangle(2, 1) = 9: Triangle(2, 2) = 3
Triangle(3, 1) = 4: Triangle(3, 2) = 7
Triangle(4, 1) = 1: Triangle(4, 2) = 2

' Call the PtInPoly function using the above declared coordinates
PtInTriangle = PtInPoly(Xcoord, Ycoord, Triangle)


End Function

You can separate the assignments to the Triangle array onto separate lines of code if you want, but I chose to put two per line of code (using the colon operator to separate the two assignments) so you could more easily see the X, Y coordinate relationship. Of course, you would create new function for each of your predefined shapes. One thought depending on how you plan to call your new functions... if you will need to iterate them instead of call specific ones by name, then you can create one new function that include all definitions in it, add an Index argument to your new function's argument list and then use that Index value in a Select Case block to call the particularly iterated polygon.

[rricki]

Rick ! I appretiate your activities and your willingness to show your knowledge in this forum.
I need exactly something like this to build simple selection of scroll compressors according the suction and condensing temperatures which are coordinates, which will or wont be in working area of compressor = polygon.

i have another silly problem with that. ..as i downloaded the excel , and i have tryed to copy the sheet from your excel to mine,
the function was not operatable..... and i am sure i did copy all the code within VB into the right sheet, via "insert" / "module" , paste there the code , and saved everithing..

but function in new excel does not work...
do you have clue, what should be the problem ??

thank you wery much for your answer
Richard


Wow, great! I am so glad you made that comment as I often wonder if anyone actually puts any of the stuff I post to practical use.



If I understand you correctly, you have predefined polygons that will not change and you want to bundle their coordinates directly into my function. Rather than do that, I would leave my function as is and create new functions that have the coordinates predefined in them and have those new function call my PtInPoly function passing the predefined array of coordinates to it. Here is an example of what I am thinking using a triangle as the predefined polygon. The triangle coordinates will be (1,2), (9,3) and (4,7). Here is the function I am suggesting you create for this fixed polygon...


Function PtInTriangle(Xcoord As Double, Ycoord As Double) As Boolean

' Remember, the shape must be closed, so there must
' be one array element more than shape corners and
' the first and last coordinates must be the same
Dim Triangle(1 To 4, 1 To 2) As Double

' Define the Triangle
' -------------------
' Xcoords : Ycoords
Triangle(1, 1) = 1: Triangle(1, 2) = 2
Triangle(2, 1) = 9: Triangle(2, 2) = 3
Triangle(3, 1) = 4: Triangle(3, 2) = 7
Triangle(4, 1) = 1: Triangle(4, 2) = 2

' Call the PtInPoly function using the above declared coordinates
PtInTriangle = PtInPoly(Xcoord, Ycoord, Triangle)


End Function

You can separate the assignments to the Triangle array onto separate lines of code if you want, but I chose to put two per line of code (using the colon operator to separate the two assignments) so you could more easily see the X, Y coordinate relationship. Of course, you would create new function for each of your predefined shapes. One thought depending on how you plan to call your new functions... if you will need to iterate them instead of call specific ones by name, then you can create one new function that include all definitions in it, add an Index argument to your new function's argument list and then use that Index value in a Select Case block to call the particularly iterated polygon.

[NinjaTic]

Hi Rick. I registered on this forum just to thank you for your code. I am using it in an application for a client that owns around 200 cranes (mobile cranes used in industry) - a system on the crane sends it's coordinates back to my server where I have pre-defined areas of responsibilities configured. Using your code, I can now determine when a crane enters a new area and alert that foreman (who is responsible for that specific area/polygon) that he is now responsible for that new crane. Brilliant!


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwTUdEgR4bdt6crKXF4AaABAg.9xmkXGSciKJ9xonTti2s Ix (https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwTUdEgR4bdt6crKXF4AaABAg.9xmkXGSciKJ9xonTti2s Ix)
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwWw16qBFX39JCRRm54AaABAg.9xnskBhPnmb9xoq3mGxu _b (https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgwWw16qBFX39JCRRm54AaABAg.9xnskBhPnmb9xoq3mGxu _b)
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9xon1p2ImxO (https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9xon1p2ImxO)
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgybZfNJd3l4FokX3cV4AaABAg.9xm_ufqOILb9xooIlv5P LY (https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgybZfNJd3l4FokX3cV4AaABAg.9xm_ufqOILb9xooIlv5P LY)
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9y38bzbSqaG (https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgzgWvzV-kvC4TJ8O414AaABAg.9xnFzCj8HRM9y38bzbSqaG)
https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgyWm8nL7syjhiHtpBF4AaABAg.9xmt8i0IsEr9y3FT9Y9F eM (https://www.youtube.com/watch?v=XQAIYCT4f8Q&lc=UgyWm8nL7syjhiHtpBF4AaABAg.9xmt8i0IsEr9y3FT9Y9F eM)
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg.9xhyRrsUUOM9xpn-GDkL3o (https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg.9xhyRrsUUOM9xpn-GDkL3o)
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg (https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1 (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Rick Rothstein]

Hi Rick. I registered on this forum just to thank you for your code. I am using it in an application for a client that owns around 200 cranes (mobile cranes used in industry) - a system on the crane sends it's coordinates back to my server where I have pre-defined areas of responsibilities configured. Using your code, I can now determine when a crane enters a new area and alert that foreman (who is responsible for that specific area/polygon) that he is now responsible for that new crane. Brilliant!

Thank you for letting me know that my function has been so helpful to you in your work... I really appreciate the feedback. Funny, but when I posted that code, I figured it would be of novelty interest only to my readers; but you, and some others who posted above, have indicate that it has a variety of real-world applications... who would have thought. Thank you again for your feedback. By the way, now that you are a registered member of this forum, please come back often... both to "my little corner of the world" here and to the main forum itself (click the big Forum button under the forum's logo above) and posts question that you may have, offer solutions to question others ask when you are able to, or just look around to see what's going on.

[theCloud]

NOTE #3: Points extremely close to, or theoretically lying on, the polygon borders may or may not report back correctly... the vagrancies of floating point math, coupled with the limitations that the "significant digits limit" in VBA imposes, can rear its ugly head in those circumstances producing values that can calculate to either side of the polygon border being tested (remember, a mathematical line has no thickness, so it does not take too much of a difference in the significant digits to "move" a calculated point's position to one side or the other of such a line).

Apologies if this gets messed up - first posting .....

I have been doing some basic testing and find that generally when on boundary, I'm getting a false values. My thoughts on dealing with this is to check for X/Y values +/- .001% either side and if any return true, it's close enough to on the line to be true.

Can you see any faults with that ? I'm writing code for checking aircraft Centre of Gravity limits, so hoping to be reasonably accurate,

Love your work by the way :-)

TheCloud

[Rick Rothstein]

I have been doing some basic testing and find that generally when on boundary, I'm getting a false values. My thoughts on dealing with this is to check for X/Y values +/- .001% either side and if any return true, it's close enough to on the line to be true.

Can you see any faults with that ? I'm writing code for checking aircraft Centre of Gravity limits, so hoping to be reasonably accurate..

The following is untested because I do not have a data setup to use, nor a set of prescribed boundary points to check, but I think I modified everything correctly. Since you seem to have the necessary data, I'll let you check it out.:)

What I have done is resurrect an old IsNearLine function I had written about the same time I wrote the PtInPoly function (somewhere between 10 and 15 years ago now), modified its argument to accept line end points as defined in the PtInPoly function, and added a Tolerance constant (the Const statement) so you can play around with that value in order to fine-tune it. Since I had to modify part of PtInPoly to accommodate the call out to the IsNearLine function, I am posting all the code you will need below (it replaces you current copy of my PtInPoly function. To repeat, this is all untested, so I cannot guarantee it will work, but in my mind's eye, I do not see why it won't... please let me, and the readers of this thread, know how your experimentation with it works out. I would also note that I expect the calculations to go slower because of the added, repeated calls to the IsNearLine function, but I do not have a feel for how much (maybe you could let us know your impressions on that as well).


Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim x As Long, NumSidesCrossed As Long, m As Double, B As Double, Poly As Variant
Const Tolerance As Double = 0.001
Poly = Polygon
For x = LBound(Poly) To UBound(Poly) - 1
If Poly(x, 1) > Xcoord Xor Poly(x + 1, 1) > Xcoord Then
m = (Poly(x + 1, 2) - Poly(x, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
B = (Poly(x, 2) * Poly(x + 1, 1) - Poly(x, 1) * Poly(x + 1, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
If IsNearLine(Poly(x, 1), Poly(x, 2), Poly(x + 1, 1), Poly(x + 1, 2), Xcoord, Ycoord, Tolerance) Then
NumSidesCrossed = NumSidesCrossed + 1
ElseIf m * Xcoord + B > Ycoord Then
NumSidesCrossed = NumSidesCrossed + 1
End If
End If
Next
PtInPoly = CBool(NumSidesCrossed Mod 2)
End Function


Function IsNearLine(X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, _
PX As Variant, PY As Variant, Tolerance As Variant) As Boolean
Dim A As Double, B As Double, C As Double, DistPtToLine As Double
If ((PX - X1) * (PX - X1) + (PY - Y1) * (PY - Y1) < Tolerance * Tolerance) Or _
((PX - X2) * (PX - X2) + (PY - Y2) * (PY - Y2) < Tolerance * Tolerance) Then
IsNearLine = True
Else
A = Y2 - Y1
B = X1 - X2
C = X2 * Y1 - Y2 * X1
DistPtToLine = Abs((A * PX + B * PY + C) / Sqr(A * A + B * B))
If DistPtToLine <= Tolerance Then
If X2 > X1 And PX > X1 And PX < X2 Then
If Y2 > Y1 And PY > Y1 And PY < Y2 Or Y2 < Y1 And PY < Y1 And PY > Y2 Then
IsNearLine = True
End If
ElseIf X2 < X1 And PX < X1 And PX > X2 Then
If Y2 > Y1 And PY > Y1 And PY < Y2 Or Y2 < Y1 And PY < Y1 And PY > Y2 Then
IsNearLine = True
End If
End If
End If
End If
End Function

[hagent]

Hi Rick,

First, thank you very much for creating this module.

I'm trying to use it for a test procedure for quality control.

The 4 sided polygon that I'm using is very small the X and Y coordinates are in the x0.3200, y0.3300 and x0.3400, y0.3500 range. Out to 4 decimal places.

I'm getting a Compile error: ByRef argument type mismatch.

It has highlighted the following


Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim x As Long, NumSidesCrossed As Long, m As Double, B As Double, Poly As Variant
Const Tolerance As Double = 0.001
Poly = Polygon
For x = LBound(Poly) To UBound(Poly) - 1
If Poly(x, 1) > Xcoord Xor Poly(x + 1, 1) > Xcoord Then
m = (Poly(x + 1, 2) - Poly(x, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
B = (Poly(x, 2) * Poly(x + 1, 1) - Poly(x, 1) * Poly(x + 1, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
If IsNearLine(Poly

With "Poly" as being the culprit after If IsNearLine(Poly

I'm using a closed Polygon with 5 x & Y points the last XY being the same as the first one.

In my particular case this is the call out =PtInPoly(B40,C40,S39:T43)

B40 would be X and C40 Y, and S39:T43 the polygon points.

I'm using Excel 2010.

Thank you for your help.

You are providing a great service to us all.

Ps. I'm a Excel Noob.

Google CIE 1931

[hagent]

Hi Rick,

I was able to get the first code to work!

Thanks so much.

You really helped me a lot.

Cheers,

Hagen

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://stackoverflow.com/questions/32736915/how-to-clear-office-clipboard-with-vba/79137321#79137321 (https://stackoverflow.com/questions/32736915/how-to-clear-office-clipboard-with-vba/79137321#79137321)
https://stackoverflow.com/questions/64066265/clearing-the-clipboard-in-office-365/79137208#79137208 (https://stackoverflow.com/questions/64066265/clearing-the-clipboard-in-office-365/79137208#79137208)
https://eileenslounge.com/viewtopic.php?p=321817&sid=48f7ab4ec7b36a168c9213377acee8b7#p321817 (https://eileenslounge.com/viewtopic.php?p=321817&sid=48f7ab4ec7b36a168c9213377acee8b7#p321817)
https://eileenslounge.com/viewtopic.php?p=321817#p321817 (https://eileenslounge.com/viewtopic.php?p=321817#p321817)
https://eileenslounge.com/viewtopic.php?f=30&t=31849&p=321822#p321822 (https://eileenslounge.com/viewtopic.php?f=30&t=31849&p=321822#p321822)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Goodwood]

Good day Rick,

Your code 'Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant' works very well. I am writing to say thank you for creating it and also for answering questions and posting potential pitfalls.

Next, is this code offered as freeware, shareware, or another sort of fee schedule? I am not using it for any sort of profit at the present time, but if I elect to in the future I would like to know if there are any potential strings attached. Obviously I will cite you with credit as to the creator and authorship of the code where used. Please respond at our convenience. Thank you for your time.

Respectfully,


Brett

Cultural Resource Management
Master's Candidate
St. Cloud State University

[Rick Rothstein]

Good day Rick,

Your code 'Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant' works very well. I am writing to say thank you for creating it and also for answering questions and posting potential pitfalls.

Next, is this code offered as freeware, shareware, or another sort of fee schedule? I am not using it for any sort of profit at the present time, but if I elect to in the future I would like to know if there are any potential strings attached. Obviously I will cite you with credit as to the creator and authorship of the code where used. Please respond at our convenience. Thank you for your time.

Hi Brett,

Thank you for you nice comments... much appreciated. As for using the code... there are no strings attached... if I post something online without specifically marking it copyrighted or "restricted use" or some other such marking, then you are free to use it in anyway you see fit. With that said, if you make a commercial product using it, I would hope you would contact me and make a donation of some kind to me for my efforts, but that would be strictly voluntary on your part... to repeat, if not marked otherwise, you are free to use anything I post in anyway you see fit.

[qetuol]

Hello,

first of all, thank you for your code. Im an optical engineer, and i need to mesh a polygon (equally distribute points) to calculate the homogenity of the luminance at these points, this is why your code is helpful to me.

However, i have a couple questions:



Poly = Polygon why is this line needed? declaring an other variable seems to be unnecessary to me, can i use just polygon instead of poly?


PtInPoly = CBool(NumSidesCrossed Mod 2) what is the exact purpose of CBool? NumSidesCrossed Mod 2 gives 1 or 0 (remember, PtInPoly is a variant, not boolean) which can be used as the condition input for IF, no need to make the code longer with CBoolean.

you mention that the first and last point of the polygon have to be the same. Since this is a _must_ condition, why not write the code in such a way, that the last point would be added as the first point. this way no error correction would be necessary, since the last point would be automatically copied from the first point.

[Rick Rothstein]

However, i have a couple questions:


Poly = Polygon why is this line needed? declaring an other variable seems to be unnecessary to me, can i use just polygon instead of poly?

The Polygon argument can be either a two-dimensional VBA array or a two-dimensional range. If it is a range, assigning that range to a Variant variable converts it to a two-dimensional VBA array so that the rest of the code ends up with the same kind of array as when a real two-dimensional array is inputted. The reason the assignment has to take place within the code is because the coercion to an array does not take place via the argument itself even if that argument is a Variant. So, that line of code makes the overall function flexible enough to handle a real array (assigning such an array to the Variant variable does not change its structure) or a range (because the range gets converted to a real array).





PtInPoly = CBool(NumSidesCrossed Mod 2) what is the exact purpose of CBool? NumSidesCrossed Mod 2 gives 1 or 0 (remember, PtInPoly is a variant, not boolean) which can be used as the condition input for IF, no need to make the code longer with CBoolean.

I wanted the function to return either TRUE or FALSE directly in case the function was to be used directly in a MessageBox or to fill a TextBox or any other number of uses besides as the argument to an IF function... the idea being the user can implement the function without having to take special steps to format the output for the occasion. As for why PtInPoly is a Variant and not a Boolean... that was so it could accommodate the error messages when called as a UDF directly on a worksheet.




you mention that the first and last point of the polygon have to be the same. Since this is a _must_ condition, why not write the code in such a way, that the last point would be added as the first point. this way no error correction would be necessary, since the last point would be automatically copied from the first point.

It was a design decision to help a user not make a mistake. If the user accidentally grabbed the wrong number of rows from a table of coordinates and inputted that too short range of values, the function would alert the user to the error because the last point did not equal the first point... if I made the function close the polygon automatically, it would blindly calculate values and the user would not be aware some of the answers were incorrect... by forcing the user to make sure the polygon closed, he/she could never make a mistake of accidentally inputting too few points.

[qetuol]

The Polygon argument can be either a two-dimensional VBA array or a two-dimensional range. If it is a range, assigning that range to a Variant variable converts it to a two-dimensional VBA array so that the rest of the code ends up with the same kind of array as when a real two-dimensional array is inputted. The reason the assignment has to take place within the code is because the coercion to an array does not take place via the argument itself even if that argument is a Variant. So, that line of code makes the overall function flexible enough to handle a real array (assigning such an array to the Variant variable does not change its structure) or a range (because the range gets converted to a real array).




I wanted the function to return either TRUE or FALSE directly in case the function was to be used directly in a MessageBox or to fill a TextBox or any other number of uses besides as the argument to an IF function... the idea being the user can implement the function without having to take special steps to format the output for the occasion. As for why PtInPoly is a Variant and not a Boolean... that was so it could accommodate the error messages when called as a UDF directly on a worksheet.




It was a design decision to help a user not make a mistake. If the user accidentally grabbed the wrong number of rows from a table of coordinates and inputted that too short range of values, the function would alert the user to the error because the last point did not equal the first point... if I made the function close the polygon automatically, it would blindly calculate values and the user would not be aware some of the answers were incorrect... by forcing the user to make sure the polygon closed, he/she could never make a mistake of accidentally inputting to few points.

Rick, thank you for the quick response and clarifications. Anyway, if i want to include each vertex of the polygon only once, not doubling the first and last point, how should i modify the code? is it correct if
For x = LBound(Poly) To UBound(Poly) - 1 is changed to
For x = LBound(Poly) To UBound(Poly) - 2 ? thanks

[Rick Rothstein]

Rick, thank you for the quick response and clarifications. Anyway, if i want to include each vertex of the polygon only once, not doubling the first and last point, how should i modify the code? is it correct if
For x = LBound(Poly) To UBound(Poly) - 1 is changed to
For x = LBound(Poly) To UBound(Poly) - 2 ? thanks
No, that part of the code would not change... however, you would have to add code to extend the array one additional array element in order to add the first point as a last point so that the For..Next loop would have a last side to test against. Unfortunately, you cannot use ReDim Preserve to expand the array as it is the first element that needs to be increased by one, so you will need to create a new array that is one row bigger than the passed-in array, transfer the elements of the passed-in array to the new array one element at a time and then duplication the first element into the new array's last element and change the array name in the loop to the newly created array's name. Doing this will slow down the function slightly. Personally, forcing the polygon closed before it is passed into the procedure seems more logical to me as the alternative does not seem worth the extra code that would be needed or time necessary to actually encode it. You may feel free to do so if you really think that extra array element to close the polygon is "unsightly" in some way as you have the base code to work from and the above outline of the steps that would be needed.


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg (https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1 (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg (https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg)
https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg (https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9 (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q)
https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I (https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I)
https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3 (https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg)
https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M (https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M)
ttps://www.youtube.com/watch?v=LP9fz2DCMBE (ttps://www.youtube.com/watch?v=LP9fz2DCMBE)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg)
https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8 (https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8)
ttps://www.youtube.com/watch?v=bFxnXH4-L1A (ttps://www.youtube.com/watch?v=bFxnXH4-L1A)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG)
https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg (https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg)
ttps://www.youtube.com/watch?v=GqzeFYWjTxI (ttps://www.youtube.com/watch?v=GqzeFYWjTxI)
https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg (https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[hugohonda]

This function is not one that many will find a use for, but if you ever need its functionality, then here it is. The function can be called from other VB code or used as a UDF (user defined function) directly on a worksheet. What it does is tell you whether a point is located inside a polygon (simple or complex, convex or concave) or not. That's it... if you should ever need such a function, this is the code for it...


Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant
Poly = Polygon
If Not (Poly(LBound(Poly), 1) = Poly(UBound(Poly), 1) And _
Poly(LBound(Poly), 2) = Poly(UBound(Poly), 2)) Then
If TypeOf Application.Caller Is Range Then
PtInPoly = "#UnclosedPolygon!"
Else
Err.Raise 998, , "Polygon Does Not Close!"
End If
Exit Function
ElseIf UBound(Poly, 2) - LBound(Poly, 2) <> 1 Then
If TypeOf Application.Caller Is Range Then
PtInPoly = "#WrongNumberOfCoordinates!"
Else
Err.Raise 999, , "Array Has Wrong Number Of Coordinates!"
End If
Exit Function
End If
For x = LBound(Poly) To UBound(Poly) - 1
If Poly(x, 1) > Xcoord Xor Poly(x + 1, 1) > Xcoord Then
m = (Poly(x + 1, 2) - Poly(x, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
b = (Poly(x, 2) * Poly(x + 1, 1) - Poly(x, 1) * Poly(x + 1, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
Next
PtInPoly = CBool(NumSidesCrossed Mod 2)
End Function


The theory behind the function is simplicity itself... start at the point being tested and project a line from that point outward in any direction (I chose straight up as that made some of the math easier) and count how many polygon sides it crosses... if the number of sides is odd, the point lies inside the polygon and if the number of sides is even, the point lies outside of the polygon. The function will return either True, False (for inside/outside respectively) or an error message (see below). The first argument is the X-Coordinate and the second argument is the Y-Coordinate of the point you want to test for being inside the polygon or not. The third argument is either a two-dimensional array of numbers (when called from another VB code procedure) or a range of numbers consisting of two columns and as many rows as needed (when called from a worksheet). The numbers describe the nodes composing the polygon.

NOTE #1: The polygon must be closed, meaning the first listed point and the last listed point must be the same. If they are not the same, the function will raise "Error #998 - Polygon Does Not Close!" if the function was called from other VB code or it will return #UnclosedPolygon! if called from the worksheet. Normally, if called from a worksheet, you would probably be using the function in a formula something like this...

=IF(PtInPoly(B9,C9,E18:F37),"In Polygon","Out Polygon")

In that case, the formula will return a #VALUE! error, not the #UnclosedPolygon! error, because the returned value to the IF function is not a Boolean; however, if you select the "PtInPoly(B9,C9,E18:F37)" part of the function in the Formula Bar and press F9, it will show you the returned value from the PtInPoly function as being #UnclosedPolygon!.

NOTE #2: The range or array specified for the third argument must be two-dimensional. If it is not, then the function will raise "Error #999 - Array Has Wrong Number Of Coordinates!" if the function was called from other VB code or it will return #WrongNumberOfCoordinates! if called from the worksheet. Error reporting when called from the worksheet will be the same as described in NOTE #1.

NOTE #3: Points extremely close to, or theoretically lying on, the polygon borders may or may not report back correctly... the vagrancies of floating point math, coupled with the limitations that the "significant digits limit" in VBA imposes, can rear its ugly head in those circumstances producing values that can calculate to either side of the polygon border being tested (remember, a mathematical line has no thickness, so it does not take too much of a difference in the significant digits to "move" a calculated point's position to one side or the other of such a line).

NOTE #4: While I think error checking is a good thing, the setup for this function is rather straightforward and, with the possible exception of the requirement for the first and last point needing to be the same, easy enough for the programmer to maintain control over during coding. If you feel confident in your ability to meet the needs of NOTE #1 and NOTE #2 without having the code "looking over your shoulder", then the function can be simplified down to this compact code...


Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant
Poly = Polygon
For x = LBound(Poly) To UBound(Poly) - 1
If Poly(x, 1) > Xcoord Xor Poly(x + 1, 1) > Xcoord Then
m = (Poly(x + 1, 2) - Poly(x, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
b = (Poly(x, 2) * Poly(x + 1, 1) - Poly(x, 1) * Poly(x + 1, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
Next
PtInPoly = CBool(NumSidesCrossed Mod 2)
End Function


Hi Rick,

first thanks for sharing your code, it has been very useful to me. Similar to theCloud, i work with aircraft center of gravity and needed a function similar to yours. However I had some problems:
1- when a point was on a vertical boundarie
2- when a point was on an horizontal boundarie
3- when comparing two Double variable (b = Ycoord)...so I replace Double by Single and it works for now...I might need to use Double in the future, we'll see how it goes

maybe this will help somebody, if you see any problems with my changes let me know

thanks


Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim X As Long, NumSidesCrossed As Long, m As Single, b As Single, Poly As Variant '*********changed m and b variable type from Double to Single
Dim btest As Single
Poly = Polygon
If Not (Poly(LBound(Poly), 1) = Poly(UBound(Poly), 1) And Poly(LBound(Poly), 2) = Poly(UBound(Poly), 2)) Then
If TypeOf Application.Caller Is Range Then
PtInPoly = "#UnclosedPolygon!"
Else
Err.Raise 998, , "Polygon Does Not Close!"
End If
Exit Function
ElseIf UBound(Poly, 2) - LBound(Poly, 2) <> 1 Then
If TypeOf Application.Caller Is Range Then
PtInPoly = "#WrongNumberOfCoordinates!"
Else
Err.Raise 999, , "Array Has Wrong Number Of Coordinates!"
End If
Exit Function
End If
For X = LBound(Poly) To UBound(Poly) - 1
Continu:
If Poly(X, 1) >= Xcoord Xor Poly(X + 1, 1) >= Xcoord Then '************changed > for >= to accomodate a point located on a vertical boundarie limit
m = (Poly(X + 1, 2) - Poly(X, 2)) / (Poly(X + 1, 1) - Poly(X, 1))
b = (Poly(X, 2) * Poly(X + 1, 1) - Poly(X, 1) * Poly(X + 1, 2)) / (Poly(X + 1, 1) - Poly(X, 1))
If m = 0 And b = Ycoord Then '********* added this "if statement" to check if point is on horizontal boundaries limit
If X < UBound(Poly) - 1 Then
X = X + 1
GoTo Continu:
Else
Exit For
End If
Else
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
End If
Next X
PtInPoly = CBool(NumSidesCrossed Mod 2)
End Function

[Rick Rothstein]

Hi Rick,

first thanks for sharing your code, it has been very useful to me. Similar to theCloud, i work with aircraft center of gravity and needed a function similar to yours. However I had some problems:
1- when a point was on a vertical boundarie
2- when a point was on an horizontal boundarie
3- when comparing two Double variable (b = Ycoord)...so I replace Double by Single and it works for now...I might need to use Double in the future, we'll see how it goes

For point numbers 1 and 2, I would refer you to my Note #3. You should not be overly fixated on points lying on the boundary of your polygon. Too many things can affect whether a point actually lies on the boundary. VB's floating point math is not infinite in scale, so the numbers have a limited precision (15 decimal places) and each number in a calculation theoretically degrades the accuracy of the calculated number to the point that you can never be sure if the calculated coordinate really lies on the boundary or not. For example, let's assume point is actually on the boundary... what is the significance if that is considered inside or outside the polygon on a practical level. Given that a theoretical boundary line for a polygon has zero thickness, then if the point was a millionth, trillions, zillions or whatever further away, it would be considered outside the polygon... similarly, if the point were as millionth, trillions, zillions or whatever closer in, it would be considered inside the polygon. At a practical level, either of those points (the further out one or the closer in one) could be considered the same point (what is the practical significance of two points that are a trillions of a inch, millimeter or whatever units of measurement?) So whether a real boundary point calculates inside or outside of the polygon should have absolutely no real world significance at all.

As for changing Doubles to Singles... I would not do that as it lessens the accuracy of all calculations that take place in the routine increasing the chance that a point in the vicinity of the boundary, but not truly "next to" or "on" it might calculate to the wrong side. Rather than making Doubles into Singles, leave them as Doubles and when comparing them, round each of the values down to the same number of decimal place (you choose the number of decimal places that is significant to you) and then compare those rounded down values instead.

[hugohonda]

For point numbers 1 and 2, I would refer you to my Note #3. You should not be overly fixated on points lying on the boundary of your polygon. Too many things can affect whether a point actually lies on the boundary. VB's floating point math is not infinite in scale, so the numbers have a limited precision (15 decimal places) and each number in a calculation theoretically degrades the accuracy of the calculated number to the point that you can never be sure if the calculated coordinate really lies on the boundary or not. For example, let's assume point is actually on the boundary... what is the significance if that is considered inside or outside the polygon on a practical level. Given that a theoretical boundary line for a polygon has zero thickness, then if the point was a millionth, trillions, zillions or whatever further away, it would be considered outside the polygon... similarly, if the point were as millionth, trillions, zillions or whatever closer in, it would be considered inside the polygon. At a practical level, either of those points (the further out one or the closer in one) could be considered the same point (what is the practical significance of two points that are a trillions of a inch, millimeter or whatever units of measurement?) So whether a real boundary point calculates inside or outside of the polygon should have absolutely no real world significance at all.

As for changing Doubles to Singles... I would not do that as it lessens the accuracy of all calculations that take place in the routine increasing the chance that a point in the vicinity of the boundary, but not truly "next to" or "on" it might calculate to the wrong side. Rather than making Doubles into Singles, leave them as Doubles and when comparing them, round each of the values down to the same number of decimal place (you choose the number of decimal places that is significant to you) and then compare those rounded down values instead.

Hi Rick,

first, thanks for your quick reply. I like your idea with using the round function with Doubles...I implemented it and it works great now.

As for my point numbers 1 and 2, I understand everything you mentioned and you are absolutely right. The thing is, I'm plotting different weight (y axis) and center of gravity (x axis) of an aircraft into a "Flight Envelope" and all point needs to be inside the envelope otherwise it isn't safe to fly. In order to find if a specific aircraft configuration (weight and CG) is dangerous to fly, I had to modify the code as mentioned before.

I know that the specific aircraft configuration touching the boundary, theoretically, won't be exactly on the line because like you mentioned, "a line has no thickness" but it will give me, I think, a very accurate aircraft configuration at which it is dangerous to fly.

I don't know if i'm clear but this is why i'm concerned about boundary.

I tested my code with many case scenarios and all of them give me a good result so far

thanks again!

[Rick Rothstein]

As for my point numbers 1 and 2, I understand everything you mentioned and you are absolutely right. The thing is, I'm plotting different weight (y axis) and center of gravity (x axis) of an aircraft into a "Flight Envelope" and all point needs to be inside the envelope otherwise it isn't safe to fly. In order to find if a specific aircraft configuration (weight and CG) is dangerous to fly, I had to modify the code as mentioned before.

You are talking about aircraft and you are worried about what amounts to infinitesimally small fractions of an inch? I think you are being overly trusting in the supposed accuracy of numerical calculations on a computer. All floating point calculations on a computer are approximations Unless your numbers have power of 2 factors, the conversion from the decimal system we work in to the binary system computers use will involve rounding errors out at the 15th or 16th decimal place which will propagate with each calculation you do with those numbers... that is why the "which side of the line with no thickness" problem is an issue at all... small changes out in the 15th or 16th decimal place are more than enough to move a calculated point onto either side of a line with no thickness. Just so you know, what I discussed about points near the border applies to all borders, not just horizontal or vertical ones. If you really want to be "safe" (your word, not mine), you should shrink your polygon by some percentage that you are comfortable with so that it does not matter which side of a boundary line a boundary point falls on.

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)
https://eileenslounge.com/viewtopic.php?p=318868#p318868 (https://eileenslounge.com/viewtopic.php?p=318868#p318868)
https://eileenslounge.com/viewtopic.php?p=318311#p318311 (https://eileenslounge.com/viewtopic.php?p=318311#p318311)
https://eileenslounge.com/viewtopic.php?p=318302#p318302 (https://eileenslounge.com/viewtopic.php?p=318302#p318302)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317704#p317704 (https://eileenslounge.com/viewtopic.php?p=317704#p317704)
https://eileenslounge.com/viewtopic.php?p=317857#p317857 (https://eileenslounge.com/viewtopic.php?p=317857#p317857)
https://eileenslounge.com/viewtopic.php?p=317541#p317541 (https://eileenslounge.com/viewtopic.php?p=317541#p317541)
https://eileenslounge.com/viewtopic.php?p=317520#p317520 (https://eileenslounge.com/viewtopic.php?p=317520#p317520)
https://eileenslounge.com/viewtopic.php?p=317510#p317510 (https://eileenslounge.com/viewtopic.php?p=317510#p317510)
https://eileenslounge.com/viewtopic.php?p=317547#p317547 (https://eileenslounge.com/viewtopic.php?p=317547#p317547)
https://eileenslounge.com/viewtopic.php?p=317573#p317573 (https://eileenslounge.com/viewtopic.php?p=317573#p317573)
https://eileenslounge.com/viewtopic.php?p=317574#p317574 (https://eileenslounge.com/viewtopic.php?p=317574#p317574)
https://eileenslounge.com/viewtopic.php?p=317582#p317582 (https://eileenslounge.com/viewtopic.php?p=317582#p317582)
https://eileenslounge.com/viewtopic.php?p=317583#p317583 (https://eileenslounge.com/viewtopic.php?p=317583#p317583)
https://eileenslounge.com/viewtopic.php?p=317605#p317605 (https://eileenslounge.com/viewtopic.php?p=317605#p317605)
https://eileenslounge.com/viewtopic.php?p=316935#p316935 (https://eileenslounge.com/viewtopic.php?p=316935#p316935)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317030#p317030 (https://eileenslounge.com/viewtopic.php?p=317030#p317030)
https://eileenslounge.com/viewtopic.php?p=317014#p317014 (https://eileenslounge.com/viewtopic.php?p=317014#p317014)
https://eileenslounge.com/viewtopic.php?p=316940#p316940 (https://eileenslounge.com/viewtopic.php?p=316940#p316940)
https://eileenslounge.com/viewtopic.php?p=316927#p316927 (https://eileenslounge.com/viewtopic.php?p=316927#p316927)
https://eileenslounge.com/viewtopic.php?p=316875#p316875 (https://eileenslounge.com/viewtopic.php?p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316412#p316412 (https://eileenslounge.com/viewtopic.php?p=316412#p316412)
https://eileenslounge.com/viewtopic.php?p=316254#p316254 (https://eileenslounge.com/viewtopic.php?p=316254#p316254)
https://eileenslounge.com/viewtopic.php?p=316046#p316046 (https://eileenslounge.com/viewtopic.php?p=316046#p316046)
https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050 (https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050)
https://www.youtube.com/@alanelston2330 (https://www.youtube.com/@alanelston2330)
https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z- (https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z-)
https://eileenslounge.com/viewtopic.php?p=316154#p316154 (https://eileenslounge.com/viewtopic.php?p=316154#p316154)
https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg (https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg)
https://teylyn.com/2017/03/21/dollarsigns/#comment-191 (https://teylyn.com/2017/03/21/dollarsigns/#comment-191)
https://eileenslounge.com/viewtopic.php?p=317050#p317050 (https://eileenslounge.com/viewtopic.php?p=317050#p317050)
https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854 (https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854)
https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875 (https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875)
https://eileenslounge.com/viewtopic.php?p=316057#p316057 (https://eileenslounge.com/viewtopic.php?p=316057#p316057)
https://eileenslounge.com/viewtopic.php?p=315915#p315915 (https://eileenslounge.com/viewtopic.php?p=315915#p315915)
https://eileenslounge.com/viewtopic.php?p=316705#p316705 (https://eileenslounge.com/viewtopic.php?p=316705#p316705)
https://eileenslounge.com/viewtopic.php?p=316704#p316704 (https://eileenslounge.com/viewtopic.php?p=316704#p316704)
https://eileenslounge.com/viewtopic.php?p=176255#p176255 (https://eileenslounge.com/viewtopic.php?p=176255#p176255)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[Fikile Kentane]

Hi Rick

Thanks so much for the "PtInPoly" function. Awesome.

I'm doing field data collection in a meter audit project. My field workers complete a Meter Audit FORM and attach lat/long GIS coordinates for the location of the meters. I cover many areas and most of the time I have to name the areas using my own names. This function helps me locate if the lat/long are inside designated areas.

How I use the "PtInPoly" function is the following: I call it is inside my function in an excel spreadsheet and pass it "X-coord:lat", "Y-coord:long"d a "2-dimensional array of polygon points". My polygon is a closed polygon.

There are about 5000 waypoints points my field database. So, for each waypoint I call the "PtInPoly" and test on which area the waypoint is located. I do this by running a loop for all areas and come out of the loop after finding the matching area.

Wanted to ask if I'm allowed to modify you function and pass it four variables instead of three. Fourth one will be used for looping through all the areas?

When I'm done. I will post the modified function here for you and everyone to see.

Best
Fikile

[Rick Rothstein]

Hi Rick

Thanks so much for the "PtInPoly" function. Awesome.

I'm doing field data collection in a meter audit project. My field workers complete a Meter Audit FORM and attach lat/long GIS coordinates for the location of the meters. I cover many areas and most of the time I have to name the areas using my own names. This function helps me locate if the lat/long are inside designated areas.

How I use the "PtInPoly" function is the following: I call it is inside my function in an excel spreadsheet and pass it "X-coord:lat", "Y-coord:long"d a "2-dimensional array of polygon points". My polygon is a closed polygon.

There are about 5000 waypoints points my field database. So, for each waypoint I call the "PtInPoly" and test on which area the waypoint is located. I do this by running a loop for all areas and come out of the loop after finding the matching area.

Wanted to ask if I'm allowed to modify you function and pass it four variables instead of three. Fourth one will be used for looping through all the areas?

When I'm done. I will post the modified function here for you and everyone to see.

Best
Fikile
Note... I removed your quote of my entire original post from your post... no need to burden this forum's servers with duplicate data that does not serve to any real reference purpose in your message.

I am glad that you found my code useful to you. As to your question... sure, feel free to modify it in anyway that is useful to you. None of the code I have posted in this sub-forum is copyrighted, so you can use or modify any of it as needed.

[Fikile Kentane]

Hi Rick

I have to thank you again for the "PtInPoly" function. I need some help please. First let me explain how I use the "PtInPoly" function.

I have a number of areas where my filed workers collect electricity meter audit data using Tablets. Each data set collected from the filed where a meter is located has a lat/long (GPS coordinates). There are a number of different areas with meters are located. I use the "PtInPoly" function to get the name of the area after checking if lat/long is in the area polygon. So for each lat/long I run a loop through all areas (18 times. There are 18 areas) and come out with the area name where the lat/long is inside an area.

Below is an example of one of the areas involved. The area name is called "eBodi" and I have 4 points defining he polygon of the Ebodi erea.

---------------------------------------------------------------------------------------
'ebodi
areaName(totNumAreasElm - 6) = "ebodi"
numOfPolygonPoints(totNumAreasElm - 6) = 4

'Define the (x:y) poligon points. The shape must be closed, so there must be one array element more than shape corners and
'the first and last coordinates must be the same

'Initialize polygon point1
pPoint(totNumAreasElm - 6, 0) = -31.2064891207045:
pPoint(totNumAreasElm - 6, 1) = 28.2321971696144

'Initialize polygon point2
pPoint(totNumAreasElm - 6, 2) = -31.2045994633557:
pPoint(totNumAreasElm - 6, 3) = 28.2303846938358

'Initialize polygon point3
pPoint(totNumAreasElm - 6, 4) = -31.2080756213509:
pPoint(totNumAreasElm - 6, 5) = 28.2279014276724

'Initialize polygon point4
pPoint(totNumAreasElm - 6, 6) = -31.209143785413:
pPoint(totNumAreasElm - 6, 7) = 28.2299482763019
------------------------------------------------------------------------------------------

Before I pass these points to "PtInPoly" I first pass them into a 2 dimensional array (pP) as I understand is the requirement for the third argument of the "PtInPoly" function. I have managed t do this successfully and checked this when i was debugging my code.

The problem is, the PtInPoly function does not work when I pass it pP in my VB code. But it works when I use and array in the worksheet. I've tested it using the same polygon points.



Below is my code that I use to first assign my polygon points (pPoint) to Rick's two dimensional polygon (pP)
I pass pP to the PtInPoly function together with the lat/long GPS coordinates
-------------------------------------------------------------------------------------------------------------------------
Dim areaCounter As Integer 'areaCounter loops through all area from 0 to 17
Dim areaLocated As String '

For areaCounter = 0 To totNumAreasElm Step 1 ' Loop through all the areas

MsgBox ("testing area : " + areaName(areaCounter))

'Array of polygon points (pP). Each point is lat/long (x/y). This is the polygon that passed to Rick function
ReDim pP(0 To (numOfPolygonPoints(areaCounter) - 1), 0 To 1) As Double

'Initialize the polygon Rick polygon
Dim ppCounter As Integer
Dim pointNumber As Integer
pointNumberIncrement = 0

For ppCounter = 0 To (numOfPolygonPoints(areaCounter) - 2) Step 1 'use the for loop to assign the my polygon points (pPoint) to Rick's two dimensional polygon (pP)
pP(ppCounter, 0) = pPoint(areaCounter, 0 + pointNumberIncrement)
pP(ppCounter, 1) = pPoint(areaCounter, 1 + pointNumberIncrement)
If (ppCounter = 0) Then
pP(ppCounter + (numOfPolygonPoints(areaCounter) - 1), 0) = pPoint(areaCounter, 0 + pointNumberIncrement)
pP(ppCounter + (numOfPolygonPoints(areaCounter) - 1), 1) = pPoint(areaCounter, 1 + pointNumberIncrement)
End If
pointNumberIncrement = 2
Next ppCounter

If (PtInPoly(x, y, pP)) Then 'if the lat/long is in the area under test, PtInPoly returns a TRUE and I use this to get out of the loop

areaLocated = areaName(areaCounter)
loopCounter = totNumAreasElm

End If

areaCounter = areaCounter + 1

Next areaCounter
-------------------------------------------------------------------------------------------------------------------
Please help me understand the problem that makes "PtInPoly" not to function

[Fikile Kentane]

Hi Rick

I have solved problem above.

Had to modify my code to use the polygon array exactly the way you specified.

Its now working

Thanks a million

[Fikile Kentane]

Hi Rick

I have another question.

I'm busy with a VBA code that determines if a lat/long point lies in a specified area and I have succesfuly used your "PtInPoly" function. It works well tnx again.

My areas are defined in kml files from Google earth. How do I uploaded an example of one one of my kml area files "Bhekela - v1.kml"?

My question is, in VBA, how do I automate the process of extracting the coordinates that form polygon points of the area. What I want to do is to read the "Bhekela - v1.kml" file and extract the coordinates inside the "<coordinates>" tags (see below)
"<coordinates>
28.25959909739643,-31.20619763209652,0 28.26071545752565,-31.19702465776928,0 28.25085444969957,-31.19927874343989,0 28.24923203195886,-31.20652374573175,0 28.25959909739643,-31.20619763209652,0
</coordinates>“.

I want to read the data inside the tags "<coordinates>" and present it is the format below. pPoint is my static array for polygon points representing an area. The data below represents polygon points of a Bhekela area.

pPoint(17, 1) = -31.2061976320965: pPoint(17, 2) = 28.2595990973964
pPoint(17, 3) = -31.1970246577692: pPoint(17, 4) = 28.2607154575256
pPoint(17, 5) = -31.1992787434398: pPoint(17, 6) = 28.2508544496995
pPoint(17, 7) = -31.2065237457317: pPoint(17, 8) = 28.2492320319588
pPoint(17, 9) = -31.2061976320965: pPoint(17, 10) = 28.2595990973964

Can anyone help show me how to do this? I know how to program in VB but not an expert.

Tnx in anticipation

[gonurvia]

Hi Rick, I am trying to use your function (PtInPoly) inside a function i've made (APPROACH). It's inside an If;


Function APPROACH(P1 As Range, x1 As Double, y1 As Double) As Double

Dim A1(3, 3) As Double
Dim A2(5, 2) As Double

For i = 1 To 5 Step 2
A1(1, 1) = P1(i, 1)
A1(1, 2) = P1(i, 2)
A1(1, 3) = P1(i, 3)
A1(2, 1) = P1(i + 1, 1)
A1(2, 2) = P1(i + 1, 2)
A1(2, 3) = P1(i + 1, 3)
A1(3, 1) = P1(i + 2, 1)
A1(3, 2) = P1(i + 2, 2)
A1(3, 3) = P1(i + 2, 3)

A2(1, 1) = P1(i, 1)
A2(1, 2) = P1(i, 2)
A2(2, 1) = P1(i + 1, 1)
A2(2, 2) = P1(i + 1, 2)
A2(3, 1) = P1(i + 3, 1)
A2(3, 2) = P1(i + 3, 2)
A2(4, 1) = P1(i + 2, 1)
A2(4, 2) = P1(i + 2, 2)
A2(5, 1) = P1(i, 1)
A2(5, 2) = P1(i, 2)

If PtInPoly(x1, y1, A2) = 0 Then
APPROACH = AltXY(A1, x1, y1)
Exit For
End If
Next i

End Function
I want the function, in case the point (x1,y1) is INSIDE the polygon, to apply function AltXY (If PtInPoly(x1, y1, A2) = 0 Then...) and if not, check for other areas but for some reason its giving me the wrong result. AltXY is not badly written, as if I wanted it to give me APPROACH = 10, it still keeps giving me zeros but I don't understand why. Any help is appreciated

[Rick Rothstein]

Hi Rick, I am trying to use your function (PtInPoly) inside a function i've made (APPROACH). It's inside an If;


Function APPROACH(P1 As Range, x1 As Double, y1 As Double) As Double

Dim A1(3, 3) As Double
Dim A2(5, 2) As Double

For i = 1 To 5 Step 2
A1(1, 1) = P1(i, 1)
A1(1, 2) = P1(i, 2)
A1(1, 3) = P1(i, 3)
A1(2, 1) = P1(i + 1, 1)
A1(2, 2) = P1(i + 1, 2)
A1(2, 3) = P1(i + 1, 3)
A1(3, 1) = P1(i + 2, 1)
A1(3, 2) = P1(i + 2, 2)
A1(3, 3) = P1(i + 2, 3)

A2(1, 1) = P1(i, 1)
A2(1, 2) = P1(i, 2)
A2(2, 1) = P1(i + 1, 1)
A2(2, 2) = P1(i + 1, 2)
A2(3, 1) = P1(i + 3, 1)
A2(3, 2) = P1(i + 3, 2)
A2(4, 1) = P1(i + 2, 1)
A2(4, 2) = P1(i + 2, 2)
A2(5, 1) = P1(i, 1)
A2(5, 2) = P1(i, 2)

If PtInPoly(x1, y1, A2) = 0 Then
APPROACH = AltXY(A1, x1, y1)
Exit For
End If
Next i

End Function
I want the function, in case the point (x1,y1) is INSIDE the polygon, to apply function AltXY (If PtInPoly(x1, y1, A2) = 0 Then...) and if not, check for other areas but for some reason its giving me the wrong result. AltXY is not badly written, as if I wanted it to give me APPROACH = 10, it still keeps giving me zeros but I don't understand why. Any help is appreciated
You did not supply an x1,y1 point that fails to work so that I could test it out; however, I am suspicious of your A1 array declaration (probably your A2 array's declaration as well). You have the A1 array declared as...

Dim A1(3, 3) As Double

but then you start filling it at element number 1. Unless you are using Option Base 1, your declaration set the lower bound for the array at 0, not 1 and that might be screwing up the calculations in my code (not sure, but I think it would). Try changing your declaration to this and see if that solves the problem...

Dim A1(1 To 3, 1 To 3) As Double

This declaration set the lower bound to 1, not 0. While I don't know if it matters to your AltXY function or not, but for consistency, I would change the declaration for the A2 array in a similar way.

[Phil_n_IN]

Hi Rick,
I know this is a very old post but it's exactly what I'm looking and works great in excel! Thanks!
But now I need to figure out how to modify it so it can works in MS Access (I'm a newbie to Access).

I have two tables in Access 2016, one of points (x/y coordinates) and another of polygons (consisting of an Poly_ID and a series of x/y nodes defining each poly perimeter). I need to discover what points are in what polygon. The actual database has over 250K points and 4K polygons.

I'd like to use this function in Access but can't get my head around how to refer to a range in access. I've tried numerous methods but all are clearly not heading toward a viable solution.
Can you point me in the right direction?

Attached is a pic and txt delimited data with a few poly and points tables that i'm using for the test. (The system won't let me attach a accdb file)
1924

[Phil_n_IN]

Hi Rick,
I've figure out how to make it work in Access for a single polygon with multiple points, but this is only half the solution. I'm now stuck on how to get it to work with multiple polygons.
Using the previously attached files I created a query that limits the results to one polygon. Using your code as a base, it lists which points are within the polygon and identifies the polygons ID.

I'd appreciate any pointers you may have on how I could proceed with the next step of making it work with multiple polygons?

Thanks so much in advance



Option Explicit

Public Function PtInPoly(Xcoord As Double, Ycoord As Double) As Variant
Dim X As Long, inPoly As String, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant
Dim Xx As Long, Yy As Long, Xupper As Long, Yupper As Long, transposeArray As Variant
Dim dbs As DAO.Database
Dim Polyrst As DAO.Recordset

Set dbs = CurrentDb
Set Polyrst = dbs.OpenRecordset("SELECT x_nodes, y_nodes ,Poly_ID FROM Poly_ID_2only", dbOpenSnapshot)
With Polyrst
.MoveLast
.MoveFirst
Poly = .GetRows(.RecordCount)
End With
'GetRows() is weird in that it returns rows & columns horizontally,
' the code below "transposes" the data to read down instead of across
Xupper = UBound(Poly, 2)
Yupper = UBound(Poly, 1)
ReDim transposeArray(Xupper, Yupper)
For Xx = 0 To Xupper
For Yy = 0 To Yupper
transposeArray(Xx, Yy) = Poly(Yy, Xx)
Next Yy
Next Xx
Poly = transposeArray
'-----------------------------------------------------------
Debug.Print UBound(Poly) + 1 & " records retrieved."
For X = LBound(Poly) To UBound(Poly) - 1
If Poly(X, 0) > Xcoord Xor Poly(X + 1, 0) > Xcoord Then
m = (Poly(X + 1, 1) - Poly(X, 1)) / (Poly(X + 1, 0) - Poly(X, 0))
b = (Poly(X, 1) * Poly(X + 1, 0) - Poly(X, 0) * Poly(X + 1, 1)) / (Poly(X + 1, 0) - Poly(X, 0))
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
Next
Debug.Print NumSidesCrossed + 1; "Lines Crossed"

If CBool(NumSidesCrossed Mod 2) = True Then
inPoly = Poly(0, 2)
Else
inPoly = "not in polygon"
End If

PtInPoly = inPoly
End Function

1925

results shown in pic

[vstepaniuk]

This is a working code, which doesn't require the first and last points to be the same. The function is called IsInside() here.


Public Function IsInside(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant
Poly = Polygon
If (UBound(Poly, 2) - LBound(Poly, 2)) <> 1 Then
If TypeOf Application.Caller Is Range Then
IsInside = "#WrongNumberOfCoordinates!"
Else
Err.Raise 999, , "Array Has Wrong Number Of Coordinates!"
End If
Exit Function
End If
For x = LBound(Poly) To UBound(Poly)
If x < UBound(Poly) Then
If Poly(x, 1) > Xcoord Xor Poly(x + 1, 1) > Xcoord Then
m = (Poly(x + 1, 2) - Poly(x, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
b = (Poly(x, 2) * Poly(x + 1, 1) - Poly(x, 1) * Poly(x + 1, 2)) / (Poly(x + 1, 1) - Poly(x, 1))
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
Else
If Poly(UBound(Poly), 1) > Xcoord Xor Poly(LBound(Poly), 1) > Xcoord Then
m = (Poly(LBound(Poly), 2) - Poly(UBound(Poly), 2)) / (Poly(LBound(Poly), 1) - Poly(UBound(Poly), 1))
b = (Poly(UBound(Poly), 2) * Poly(LBound(Poly), 1) - Poly(UBound(Poly), 1) * Poly(LBound(Poly), 2)) / (Poly(LBound(Poly), 1) - Poly(UBound(Poly), 1))
If m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
End If
End If
Next
IsInside = CBool(NumSidesCrossed Mod 2)
End Function

[Rick Rothstein]

This is a working code, which doesn't require the first and last points to be the same.

See the last comment I made in Message #20 for the reason why I required the first and last points to be the same.

[KalleMikkola]

Very helpful article. Thanks for the info.

[sasNak]

Rick,

Thanks for this code it works great when selecting 2 points and a range. I am running into an issue when trying to declare and use an array that is not part of the worksheet and needs to be contained within VBA. Here is an example;

{-121.0881492,49.0034919;-122.752573,49.0143053;-122.6207152,48.4890675;-122.9503623,48.0649179;-124.7414421,48.4015977;-124.6772682,47.9216895;-124.4287242,47.6107667;-124.1041153,46.7449612;-123.9603113,46.6099799;-123.9185291,46.5126529;-123.9461777,46.4880114;-123.9383568,46.465238;-123.8621475,46.4339387;-123.8141294,46.4035448;-123.7421081,46.4535748;-123.675164,46.4619845;-123.615144,46.4675304;-123.5328079,46.4690518;-123.548661,46.422487;-123.5929627,46.4025166;-123.5974195,46.378753;-123.4670048,46.349835;-123.2086215,46.3433779;-123.2168552,46.3135429;-123.1756308,46.2893967;-123.1208701,46.3162084;-123.0413974,46.3173564;-122.9915689,46.3804367;-122.2773429,46.3804358;-121.4092836,46.384223;-121.3894058,46.4106997;-121.4052319,46.4286543;-121.4114816,46.4683527;-121.4697169,46.5242693;-121.4257641,46.5639465;-121.3793024,46.7015258;-121.3659655,46.7079506;-121.3539989,46.7148449;-121.3640585,46.7225138;-121.3755964,46.7267869;-121.4038199,46.7261524;-121.428002,46.7394693;-121.4468639,46.7693883;-121.4556718,46.8086813;-121.4860028,46.8541833;-121.5016127,46.9057334;-121.4130784,47.0044602;-121.3724424,47.0628036;-121.4037412,47.1252367;-121.4003057,47.2165027;-121.4318804,47.3114092;-121.3766667,47.3615156;-121.1156194,47.6909755;-121.0881492,49.0034919}

I want to use this array in a function, that calls PtInPoly but I am having trouble storing an array this long and getting PtInPoly to use the variant once stored. I have tried a few things but not been able to figure it out. I am sure that my basic understanding of the arrays is the problem. For storing the array I have tried;

Function TestStore() As Variant
Dim P1, P2, P3, P4, P5, P6, P7 As String
Dim sstore As Variant

P1 = "{-121.0881492,49.0034919;-122.752573,49.0143053;-122.6207152,48.4890675;-122.9503623,48.0649179;-124.7414421,48.4015977;-124.6772682,47.9216895;-124.4287242,47.6107667;-124.1041153,46.7449612;"
P2 = "-123.9603113,46.6099799;-123.9185291,46.5126529;-123.9461777,46.4880114;-123.9383568,46.465238;-123.8621475,46.4339387;-123.8141294,46.4035448;-123.7421081,46.4535748;-123.675164,46.4619845;"
P3 = "-123.615144,46.4675304;-123.5328079,46.4690518;-123.548661,46.422487;-123.5929627,46.4025166;-123.5974195,46.378753;-123.4670048,46.349835;-123.2086215,46.3433779;-123.2168552,46.3135429;"
P4 = "-123.1756308,46.2893967;-123.1208701,46.3162084;-123.0413974,46.3173564;-122.9915689,46.3804367;-122.2773429,46.3804358;-121.4092836,46.384223;-121.3894058,46.4106997;-121.4052319,46.4286543;"
P5 = "-121.4114816,46.4683527;-121.4697169,46.5242693;-121.4257641,46.5639465;-121.3793024,46.7015258;-121.3659655,46.7079506;-121.3539989,46.7148449;-121.3640585,46.7225138;-121.3755964,46.7267869;"
P6 = "-121.4038199,46.7261524;-121.428002,46.7394693;-121.4468639,46.7693883;-121.4556718,46.8086813;-121.4860028,46.8541833;-121.5016127,46.9057334;-121.4130784,47.0044602;-121.3724424,47.0628036;"
P7 = "-121.4037412,47.1252367;-121.4003057,47.2165027;-121.4318804,47.3114092;-121.3766667,47.3615156;-121.1156194,47.6909755;-121.0881492,49.0034919}"

sstore = P1 & P2 & P3 & P4 & P5 & P6 & P7
TestStore = sstore

End Function

If I could get this function to store the array so that it can work like:


=PtInPoly("-122.22","78.5226",TestStore())

..and return TRUE/FLASE I could figure the rest out.

Any help or pointers would be appreciated, thanks again for the code.

[sasNak]

Rick,

Thanks for this code it works great when selecting 2 points and a range. I am running into an issue when trying to declare and use an array that is not part of the worksheet and needs to be contained within VBA. Here is an example;

{-121.0881492,49.0034919;-122.752573,49.0143053;-122.6207152,48.4890675;-122.9503623,48.0649179;-124.7414421,48.4015977;-124.6772682,47.9216895;-124.4287242,47.6107667;-124.1041153,46.7449612;-123.9603113,46.6099799;-123.9185291,46.5126529;-123.9461777,46.4880114;-123.9383568,46.465238;-123.8621475,46.4339387;-123.8141294,46.4035448;-123.7421081,46.4535748;-123.675164,46.4619845;-123.615144,46.4675304;-123.5328079,46.4690518;-123.548661,46.422487;-123.5929627,46.4025166;-123.5974195,46.378753;-123.4670048,46.349835;-123.2086215,46.3433779;-123.2168552,46.3135429;-123.1756308,46.2893967;-123.1208701,46.3162084;-123.0413974,46.3173564;-122.9915689,46.3804367;-122.2773429,46.3804358;-121.4092836,46.384223;-121.3894058,46.4106997;-121.4052319,46.4286543;-121.4114816,46.4683527;-121.4697169,46.5242693;-121.4257641,46.5639465;-121.3793024,46.7015258;-121.3659655,46.7079506;-121.3539989,46.7148449;-121.3640585,46.7225138;-121.3755964,46.7267869;-121.4038199,46.7261524;-121.428002,46.7394693;-121.4468639,46.7693883;-121.4556718,46.8086813;-121.4860028,46.8541833;-121.5016127,46.9057334;-121.4130784,47.0044602;-121.3724424,47.0628036;-121.4037412,47.1252367;-121.4003057,47.2165027;-121.4318804,47.3114092;-121.3766667,47.3615156;-121.1156194,47.6909755;-121.0881492,49.0034919}

I want to use this array in a function, that calls PtInPoly but I am having trouble storing an array this long and getting PtInPoly to use the variant once stored. I have tried a few things but not been able to figure it out. I am sure that my basic understanding of the arrays is the problem. For storing the array I have tried;

Function TestStore() As Variant
Dim P1, P2, P3, P4, P5, P6, P7 As String
Dim sstore As Variant

P1 = "{-121.0881492,49.0034919;-122.752573,49.0143053;-122.6207152,48.4890675;-122.9503623,48.0649179;-124.7414421,48.4015977;-124.6772682,47.9216895;-124.4287242,47.6107667;-124.1041153,46.7449612;"
P2 = "-123.9603113,46.6099799;-123.9185291,46.5126529;-123.9461777,46.4880114;-123.9383568,46.465238;-123.8621475,46.4339387;-123.8141294,46.4035448;-123.7421081,46.4535748;-123.675164,46.4619845;"
P3 = "-123.615144,46.4675304;-123.5328079,46.4690518;-123.548661,46.422487;-123.5929627,46.4025166;-123.5974195,46.378753;-123.4670048,46.349835;-123.2086215,46.3433779;-123.2168552,46.3135429;"
P4 = "-123.1756308,46.2893967;-123.1208701,46.3162084;-123.0413974,46.3173564;-122.9915689,46.3804367;-122.2773429,46.3804358;-121.4092836,46.384223;-121.3894058,46.4106997;-121.4052319,46.4286543;"
P5 = "-121.4114816,46.4683527;-121.4697169,46.5242693;-121.4257641,46.5639465;-121.3793024,46.7015258;-121.3659655,46.7079506;-121.3539989,46.7148449;-121.3640585,46.7225138;-121.3755964,46.7267869;"
P6 = "-121.4038199,46.7261524;-121.428002,46.7394693;-121.4468639,46.7693883;-121.4556718,46.8086813;-121.4860028,46.8541833;-121.5016127,46.9057334;-121.4130784,47.0044602;-121.3724424,47.0628036;"
P7 = "-121.4037412,47.1252367;-121.4003057,47.2165027;-121.4318804,47.3114092;-121.3766667,47.3615156;-121.1156194,47.6909755;-121.0881492,49.0034919}"

sstore = P1 & P2 & P3 & P4 & P5 & P6 & P7
TestStore = sstore

End Function

If I could get this function to store the array so that it can work like:


=PtInPoly("-122.22","78.5226",TestStore())

..and return TRUE/FLASE I could figure the rest out.

Any help or pointers would be appreciated, thanks again for the code.

Still struggling with this and I have tried many different things. I know this is an old thread but if anyone can point me in the right direction that would be appreciated very much.

[Rick Rothstein]

Still struggling with this and I have tried many different things. I know this is an old thread but if anyone can point me in the right direction that would be appreciated very much.
Take a look at Message #9... it should give you the method needed to assign the points to an array for use in my function.

[trapper]

Hello! I can't download the attached file, can you provide another one? Thanks!

[DocAElstein]

Hi,
Try these
Share ‘PointInPolygon.xls’ - https://app.box.com/s/rkzk3spwhgo40ruq97k2lx2k6hf5extk
Share ‘PointInPolygon.xlsm’ - https://app.box.com/s/36u2i3my7voy8hwm54jcusifxdjxncdh
Share ‘PointInPolygon.xlsb’- https://app.box.com/s/cyr4veokel0uv2xvng9sqxk1chnqi53s

Alan