Edited my previous post while you were reading. Review again.
Edited my previous post while you were reading. Review again.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Making a little progress. PtInPoly is calling PIP2, but I'm getting a "Data type mismatch in criteria expression" message in the Set rsP line. I deleted "WHERE Area=1" and it then continued and gave me an "Item not found in this collection." message on the line that starts with "strM= strM & strA..."
Getting close. In addition to deleting WHERE Area=1, I also deleted strA=rsp!Area, strA & ":" & rsT!StopID & and ran it and got a message box with a list of 13 results that were either :True or :False. Removing the area references did the trick. I also received an error until I removed rsT!StopID. I need to figure out how to translate this to my query, so I can return a list with the true results. If I reference the qryPoly instead of the tblPoly, I shouldn't need to be concerned about the Area, correct, since the query filters the area?
No, PIP2 should be calling PtInPoly.
Code works perfectly with my data. Perhaps you should provide your db for analysis.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
June7 - I tried to upload the db and it exceeds the allowable file size of 500 kb (file is a little over 600 kb). I went to verify the accuracy of the output and out of the 13 stops, only 4 were correct. If you can advise on how to upload the db I'll do it this afternoon. I'll be away from my computer for most of the day.
Follow the link in June7's signature.
The more we hear silence, the more we begin to think about our value in this universe.
Paraphrase of Professor Brian Cox.
With sample data in original post, which lines should return as within polygon?
Instructions for attaching files at bottom of my post.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
I've zipped the db and attached.
Trips.zip
Sorry, I am running Access 2010 and cannot open your db because it uses 2016 features 2010 can't handle.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
I created a new db with an earlier format and copied the contents from the one I posted earlier. Maybe this will work.
Trips2.mdb
Again, which trip records do you expect to be within the polygon using PIP2 procedure? Edgar's graphic shows 6 but the code shows 5.
Why is Area a text field?
Modified code to call from query:
Query:Code:Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Integer) As Variant Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant Poly = BuildArray(Polygon) 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 PtInPoly = CBool(NumSidesCrossed Mod 2) End Function Private Function BuildArray(intArea) As Variant Dim rsP As DAO.Recordset Dim aryP(15, 2) As Double Dim x As Integer Set rsP = CurrentDb.OpenRecordset("SELECT ID, Lon, Lat, Area FROM tblPoly WHERE Area='" & intArea & "' ORDER BY Seq") Do While Not rsP.EOF aryP(x, 0) = rsP!Lon aryP(x, 1) = rsP!Lat x = x + 1 rsP.MoveNext Loop BuildArray = aryP End Function
SELECT tblTrips.*, PtInPoly([StopLon],[StopLat],[Enter Area]) AS InPoly FROM tblTrips;
[Enter Area] should be input by reference to control on form.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Thanks for the modified code June7. I'll give it a try. Should be 6 in and 7 out. 2,3,8,9,11, and 12 should be in while 1, 4,5,6,7,10, and 13 should be out. I've attached a map of the polygons (black dots) and stops (blue dots) that I plotted on a map. Stops are circled in red for better visibility and also have ID written in red.
PIP.pdf
I tried using Abs() and that had same results. Swapping Lat and Lon for x and y was worse, as expected.
So this algorithm is not producing correct output per graphics.
Back to drawing board. However, hope this example will guide you on how to adapt code to your db, once you find a good formula.
I am going to test the Excel workbook with your data and see what that produces.
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
Can't thank you enough for the time you've spent on this. I'll take your revised code and keep trying.
Now confirmed the Excel produces expected output.
I just noticed the code you show in post 7 does not use exact same m and b formulas shown in linked article and in workbook.
Finally got it right.
Code:Option Explicit Option Base 1 Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Integer) As Variant Dim x As Long, NumSidesCrossed As Long, m As Double, b As Double, Poly As Variant Poly = BuildArray(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 Private Function BuildArray(intArea) As Variant Dim rsP As DAO.Recordset Dim aryP(15, 2) As Double Dim x As Integer x = 1 Set rsP = CurrentDb.OpenRecordset("SELECT ID, Lon, Lat, Area FROM tblPoly WHERE Area='" & intArea & "' ORDER BY Seq") Do While Not rsP.EOF aryP(x, 1) = rsP!Lon aryP(x, 2) = rsP!Lat x = x + 1 rsP.MoveNext Loop BuildArray = aryP End Function
How to attach file: http://www.accessforums.net/showthread.php?t=70301 To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.