"Translating" an Excel function into Access

[Alc]

A colleague has found the following Excel function online

Public Function PtInPoly(Xcoord As Double, Ycoord As Double, Polygon As Variant) As Variant
  Dim x As Double, m As Double, b As Double, Poly As Variant
  Dim LB1 As Double, LB2 As Double, UB1 As Double, UB2 As Double, NumSidesCrossed As Double
  
  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 m * Xcoord + b > Ycoord Then NumSidesCrossed = NumSidesCrossed + 1
    End If
  Next
  PtInPoly = CBool(NumSidesCrossed Mod 2)
  
End Function

It asks for an X coordinate, a Y coordinate and an array of X and Y coordinates.
It then loops through the array and where it finds that the passed X and Y coordinates are within the array's X and Y values, it returns TRUE.
This works fine in Excel and my manager has asked me to try to translate it into doing the same thing in Access.

My attempt is as follows.
1. The function is being called correctly.
2. It's passing in X, Y and the name of the table to use to populate the array.
3. The array is being populated correctly (I tested with a msgbox at point 1).
HOWEVER
I get a subscript out of range message on the red line.
I'm not familiar with Arrays at all and trying to work out if the problem is to do with trying to adapt Excel VBA into Access or something else.
1. Can anyone spot the issue?
2. Is there anything else obviously wrong, that I should correct now? I figured using a function that was working as my base would make things easier, but now I'm doubting myself.

Public Function PtInPoly(ByVal Xcoord As Long, ByVal Ycoord As Long, ByVal DataTable As String, Db As Database) As Variant
Dim x As Long ' long column, col 1
Dim y As Long ' lat column, col 2
Dim m As Long
Dim b As Long
Dim LowerLong As Long
Dim UpperLong As Long
Dim LowerLat As Long
Dim UpperLat As Long
Dim ArrayPoly As Variant
Dim vItem As Variant
Dim NumSidesCrossed As Long
Dim RstPoly As Recordset
Dim liRecCount As Integer

Set RstPoly = Db.OpenRecordset(DataTable)
liRecCount = RstPoly.RecordCount
With RstPoly
ArrayPoly = .GetRows(.RecordCount)
End With

For Each vItem In ArrayPoly
MsgBox vItem ' - 1
Next
For x = LBound(ArrayPoly) To UBound(ArrayPoly) - 1
MsgBox ArrayPoly(x, 1) ' - 2
MsgBox ArrayPoly(x + 1, 1) ' - 3
[COLOR=red][B]If (ArrayPoly(x, 1) > Xcoord) Or (ArrayPoly(x + 1, 1) > Xcoord) Then[/B][/COLOR]
    m = (ArrayPoly(x + 1, 2) - ArrayPoly(x, 2)) / (ArrayPoly(x + 1, 1) - ArrayPoly(x, 1))
    b = (ArrayPoly(x, 2) * ArrayPoly(x + 1, 1) - ArrayPoly(x, 1) * ArrayPoly(x + 1, 2)) / (ArrayPoly(x + 1, 1) - ArrayPoly(x, 1))
    If m * Xcoord + b > Ycoord Then
        NumSidesCrossed = NumSidesCrossed + 1
    End If
End If
Next
PtInPoly = CBool(NumSidesCrossed Mod 2)

End Function

 

[CJ_London]

Not sure how you are expecting to apply this in Access, For this you do not need vba, you would use a query

Something like

SELECT *
FROM myTable
WHERE [Enter X coord]<=myTable.Y AND [Enter Y coord]>=myTable.X

Or if you want to see all records with a true or false

SELECT *, ([Enter X coord]<=myTable.Y AND [Enter Y coord]>=myTable.X) AS PtInPoly
FROM myTable


you can replace the bits in square brackets with a reference to form controls

 

[Alc]

Not sure how you are expecting to apply this in Access, For this you do not need vba, you would use a query

Something like

SELECT *
FROM myTable
WHERE [Enter X coord]<=myTable.Y AND [Enter Y coord]>=myTable.X

Or if you want to see all records with a true or false

SELECT *, ([Enter X coord]<=myTable.Y AND [Enter Y coord]>=myTable.X) AS PtInPoly
FROM myTable


you can replace the bits in square brackets with a reference to form controls

Thanks for the response, VERY much.

Short answer is I knew that the function did what was needed, so thought it would be easier to use it than to write something new.

I looked at using a query initially, but I couldn't figure out a way to deal with irregular polygon shapes (something that applies to almost all of those in my table and which this function appears to handle).

If, for example, I have a square polygon, then I can easily find the uppermost and lowermost X and Y coordinates. Any item having X and Y values higher then the polygon's lowest and lower than the polygon's highest will be inside it. However, if the polygon is L-shaped, an item could be within those parameters but still not be inside the polygon.

 

[CJ_London]

All depends on how your polygon is described in a table.

Provide the data you have for an L shaped polygon I would expect each record to contain a polygon identifier and x and y coordinates for each corner - so an L shape would have 6 records

 

[Alc]

Exactly, an L-shape would have 6 sets of coordinates. Given the variety of shapes and sizes I'm dealing with, some might have 30 or more, to take into account sales areas and local geography.

 

[pbaldy]

I'm with CJ, I'd have a table and do a quick lookup into it rather than try to loop an array.

I've got a map program for a taxi dispatch system, with zones defined within the geographical area. I have a zones table with record(s) for each zone. Some have multiple records, like your "L" would have 2, 1 for the vertical section and 1 for the horizontal. Users can drag cars (labels) around the map, and the program knows which zone the car is in based on the x/y coordinates.

The limitation is each zone must be able to be broken down into one or more rectangles, but it works for our needs. This was created before GPS, geofencing, etc, but it's still in use today. I think "crude but effective" would define it.

 

[CJ_London]

do shapes overlap?

 

[Alc]

I'm with CJ, I'd have a table and do a quick lookup into it rather than try to loop an array.

I've got a map program for a taxi dispatch system, with zones defined within the geographical area. I have a zones table with record(s) for each zone. Some have multiple records, like your "L" would have 2, 1 for the vertical section and 1 for the horizontal. Users can drag cars (labels) around the map, and the program knows which zone the car is in based on the x/y coordinates.

The limitation is each zone must be able to be broken down into one or more rectangles, but it works for our needs. This was created before GPS, geofencing, etc, but it's still in use today. I think "crude but effective" would define it.

Thanks for the suggestion. Unfortunately, I don't think any of the polygons are rectangular (I just used the L as an example). I haven't seen one yet with a right angle in it. :banghead:

do shapes overlap?

No, they're all mutually exclusive.

 

[CJ_London]

I suspect your error message is caused by the array not being dimensioned

see this link https://msdn.microsoft.com/en-us/library/aa264519(v=vs.60).aspx

in your excel function, you are passing an array that has been dimensioned

I havent had any need to use dynamic arrays but think you may need to add

redim arraypoly(liRecCount)

or you may need to parse through the recordset, redimming after assignment of each row

 

[Galaxiom]

redim arraypoly(liRecCount)

I have not looked at the context of the question, but note that rediming an array clears out its values.

To ReDim while preserving the values use the Preserve keyword:

ReDim Preserve arraypoly(liRecCount)

Best practice when declaring arrays is to always specify the lower bound.

ReDim Preserve arraypoly(0 To liRecCount)

Without the lower bound being included, the array will be dimensioned either as zero (the default Base) or according to the module Option Base declaration.

Option Base 0

Specifying the lower bound is also really useful in some circumstances when a 1 base array better suits the coding.

 

[CJ_London]

@galaxiom thanks for the correction, I don't really used dynamic arrays so useful for me for when I do!

 

[Alc]

Firstly, thanks to all those who offered their expertise to help me out. I'm always amazed by how helpful the people on here can be.

Arrays are definitely a subject about which I need to learn more, but on this occasion I went with the suggested 'table' route. I've posted the final solution below, in case it helps anyone in a similar situation.

Notes
1. Each polygon in my test contained the coordinates for a different polygon. This was for no other reason than this was how they came to us. The first and last rows in each table matched, in order to 'seal' the polygon.
2. Values passed into the function are the longitude and latitude of the point as well as the name of the table containing the coordinates of the points bordering the polygon.
3. The function returns true or false, depending on whether the point is within the polygon or not
4. I've successfully tested it with a variety of shapes, including rectangles, octagons, L and V. I have not tested it with 'doughnut' shapes.

Public Function PtInPoly(ByVal Xcoord As Double, ByVal Ycoord As Double, ByVal DataTable As String, Db As Database) As Variant
  Dim X As Long
  Dim ldLong As Double
  Dim ldNextLong As Double
  Dim ldLat As Double
  Dim ldNextLat As Double
  Dim m As Double
  Dim b As Double
  Dim vItem As Variant
  Dim NumSidesCrossed As Long
  Dim RstPoly As Recordset
  Dim liRecCount As Integer
  Dim ldFirstLong As Double
  Dim ldFirstLat As Double
  
  Set RstPoly = Db.OpenRecordset(DataTable)
  liRecCount = RstPoly.RecordCount
    X = 1
    If Not RstPoly.EOF Then
        RstPoly.MoveFirst
        ldFirstLong = RstPoly!Long
        ldFirstLat = RstPoly!Lat
        Do While X <= (liRecCount - 1)
    
            If X <> 1 And ldFirstLong = RstPoly!Long And ldFirstLat = RstPoly!Lat Then
                GoTo End_Point
            End If
            ldLong = RstPoly!Long                                                           ' -- This Long coordinate - ArrayPoly(X, 1)
            ldLat = RstPoly!Lat                                                             ' -- This Lat coordinate - ArrayPoly(X, 2)
            RstPoly.MoveNext
            ldNextLong = RstPoly!Long                                                       ' -- Next Long coordinate - ArrayPoly(X + 1, 1)
            ldNextLat = RstPoly!Lat                                                         ' -- Next Lat coordinate - ArrayPoly(X + 1, 2)
            RstPoly.MovePrevious
            If (ldLong > Xcoord) Xor (ldNextLong > Xcoord) Then
                m = (ldNextLat - ldLat) / (ldNextLong - ldLong)                         ' -- Increase in Lat/Increase in Long
                b = (ldLat * ldNextLong - ldLong * ldNextLat) / (ldNextLong - ldLong)   ' -- (Current Lat x Next Long) - Current Long/Increase in Long
                If m * Xcoord + b > Ycoord Then
                    NumSidesCrossed = NumSidesCrossed + 1
                Else
                End If
            End If
            X = X + 1
            RstPoly.MoveNext
        Loop
    End If
    
End_Point:
    PtInPoly = CBool(NumSidesCrossed Mod 2)
End Function