Originally Posted by
theCloud
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).
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
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
Reply With Quote
Bookmarks