1 Attachment(s)
Need a little help taking the next step
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
Code:
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
Attachment 1925
results shown in pic