Test Whether A Point Is In A Polygon Or Not

[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