Test Whether A Point Is In A Polygon Or Not

[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)
2017-07-14 12_47_21-Access - TEST Point-in-Polygon _ Database- E__MLS_RETS_DATA_TEST Point-in-Po.jpg

[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

TEST-Results Point-in-Polygo.jpg

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.