Page 4 of 4 FirstFirst ... 234
Results 31 to 35 of 35

Thread: Test Whether A Point Is In A Polygon Or Not

  1. #31
    Junior Member
    Join Date
    Jan 2017
    Posts
    4
    Rep Power
    0
    Hi Rick

    I have another question.

    I'm busy with a VBA code that determines if a lat/long point lies in a specified area and I have succesfuly used your "PtInPoly" function. It works well tnx again.

    My areas are defined in kml files from Google earth. How do I uploaded an example of one one of my kml area files "Bhekela - v1.kml"?

    My question is, in VBA, how do I automate the process of extracting the coordinates that form polygon points of the area. What I want to do is to read the "Bhekela - v1.kml" file and extract the coordinates inside the "<coordinates>" tags (see below)
    "<coordinates>
    28.25959909739643,-31.20619763209652,0 28.26071545752565,-31.19702465776928,0 28.25085444969957,-31.19927874343989,0 28.24923203195886,-31.20652374573175,0 28.25959909739643,-31.20619763209652,0
    </coordinates>“.

    I want to read the data inside the tags "<coordinates>" and present it is the format below. pPoint is my static array for polygon points representing an area. The data below represents polygon points of a Bhekela area.

    pPoint(17, 1) = -31.2061976320965: pPoint(17, 2) = 28.2595990973964
    pPoint(17, 3) = -31.1970246577692: pPoint(17, 4) = 28.2607154575256
    pPoint(17, 5) = -31.1992787434398: pPoint(17, 6) = 28.2508544496995
    pPoint(17, 7) = -31.2065237457317: pPoint(17, 8) = 28.2492320319588
    pPoint(17, 9) = -31.2061976320965: pPoint(17, 10) = 28.2595990973964

    Can anyone help show me how to do this? I know how to program in VB but not an expert.

    Tnx in anticipation

  2. #32
    Junior Member
    Join Date
    Mar 2017
    Posts
    1
    Rep Power
    0
    Hi Rick, I am trying to use your function (PtInPoly) inside a function i've made (APPROACH). It's inside an If;

    Code:
    Function APPROACH(P1 As Range, x1 As Double, y1 As Double) As Double
    
    Dim A1(3, 3) As Double
    Dim A2(5, 2) As Double
    
    For i = 1 To 5 Step 2
    A1(1, 1) = P1(i, 1)
    A1(1, 2) = P1(i, 2)
    A1(1, 3) = P1(i, 3)
    A1(2, 1) = P1(i + 1, 1)
    A1(2, 2) = P1(i + 1, 2)
    A1(2, 3) = P1(i + 1, 3)
    A1(3, 1) = P1(i + 2, 1)
    A1(3, 2) = P1(i + 2, 2)
    A1(3, 3) = P1(i + 2, 3)
    
    A2(1, 1) = P1(i, 1)
    A2(1, 2) = P1(i, 2)
    A2(2, 1) = P1(i + 1, 1)
    A2(2, 2) = P1(i + 1, 2)
    A2(3, 1) = P1(i + 3, 1)
    A2(3, 2) = P1(i + 3, 2)
    A2(4, 1) = P1(i + 2, 1)
    A2(4, 2) = P1(i + 2, 2)
    A2(5, 1) = P1(i, 1)
    A2(5, 2) = P1(i, 2)
    
    If PtInPoly(x1, y1, A2) = 0 Then
        APPROACH = AltXY(A1, x1, y1)
        Exit For
    End If
    Next i
    
    End Function
    I want the function, in case the point (x1,y1) is INSIDE the polygon, to apply function AltXY (If PtInPoly(x1, y1, A2) = 0 Then...) and if not, check for other areas but for some reason its giving me the wrong result. AltXY is not badly written, as if I wanted it to give me APPROACH = 10, it still keeps giving me zeros but I don't understand why. Any help is appreciated

  3. #33
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    628
    Rep Power
    6
    Quote Originally Posted by gonurvia View Post
    Hi Rick, I am trying to use your function (PtInPoly) inside a function i've made (APPROACH). It's inside an If;

    Code:
    Function APPROACH(P1 As Range, x1 As Double, y1 As Double) As Double
    
    Dim A1(3, 3) As Double
    Dim A2(5, 2) As Double
    
    For i = 1 To 5 Step 2
    A1(1, 1) = P1(i, 1)
    A1(1, 2) = P1(i, 2)
    A1(1, 3) = P1(i, 3)
    A1(2, 1) = P1(i + 1, 1)
    A1(2, 2) = P1(i + 1, 2)
    A1(2, 3) = P1(i + 1, 3)
    A1(3, 1) = P1(i + 2, 1)
    A1(3, 2) = P1(i + 2, 2)
    A1(3, 3) = P1(i + 2, 3)
    
    A2(1, 1) = P1(i, 1)
    A2(1, 2) = P1(i, 2)
    A2(2, 1) = P1(i + 1, 1)
    A2(2, 2) = P1(i + 1, 2)
    A2(3, 1) = P1(i + 3, 1)
    A2(3, 2) = P1(i + 3, 2)
    A2(4, 1) = P1(i + 2, 1)
    A2(4, 2) = P1(i + 2, 2)
    A2(5, 1) = P1(i, 1)
    A2(5, 2) = P1(i, 2)
    
    If PtInPoly(x1, y1, A2) = 0 Then
        APPROACH = AltXY(A1, x1, y1)
        Exit For
    End If
    Next i
    
    End Function
    I want the function, in case the point (x1,y1) is INSIDE the polygon, to apply function AltXY (If PtInPoly(x1, y1, A2) = 0 Then...) and if not, check for other areas but for some reason its giving me the wrong result. AltXY is not badly written, as if I wanted it to give me APPROACH = 10, it still keeps giving me zeros but I don't understand why. Any help is appreciated
    You did not supply an x1,y1 point that fails to work so that I could test it out; however, I am suspicious of your A1 array declaration (probably your A2 array's declaration as well). You have the A1 array declared as...

    Dim A1(3, 3) As Double

    but then you start filling it at element number 1. Unless you are using Option Base 1, your declaration set the lower bound for the array at 0, not 1 and that might be screwing up the calculations in my code (not sure, but I think it would). Try changing your declaration to this and see if that solves the problem...

    Dim A1(1 To 3, 1 To 3) As Double

    This declaration set the lower bound to 1, not 0. While I don't know if it matters to your AltXY function or not, but for consistency, I would change the declaration for the A2 array in a similar way.

  4. #34
    Junior Member
    Join Date
    Jul 2017
    Posts
    2
    Rep Power
    0
    Hi Rick,
    I know this is a very old post but it's exactly what I'm looking and works great in excel! Thanks!
    But now I need to figure out how to modify it so it can works in MS Access (I'm a newbie to Access).

    I have two tables in Access 2016, one of points (x/y coordinates) and another of polygons (consisting of an Poly_ID and a series of x/y nodes defining each poly perimeter). I need to discover what points are in what polygon. The actual database has over 250K points and 4K polygons.

    Id like to use this function in Access but cant get my head around how to refer to a range in access. I've tried numerous methods but all are clearly not heading toward a viable solution.
    Can you point me in the right direction?

    Attached is a pic and txt delimited data with a few poly and points tables that i'm using for the test. (The system won't let me attach a accdb file)
    2017-07-14 12_47_21-Access - TEST Point-in-Polygon _ Database- E__MLS_RETS_DATA_TEST Point-in-Po.jpg
    Attached Files Attached Files

  5. #35
    Junior Member
    Join Date
    Jul 2017
    Posts
    2
    Rep Power
    0

    Need a little help taking the next step

    Hi Rick,
    Ive figure out how to make it work in Access for a single polygon with multiple points, but this is only half the solution. Im 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.

    Id 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
    TEST-Results Point-in-Polygo.jpg

    results shown in pic

Similar Threads

  1. This is a test
    By Admin in forum Test Area
    Replies: 7
    Last Post: 05-30-2014, 10:14 AM
  2. This is a test of Signature Block
    By alansidman in forum Test Area
    Replies: 0
    Last Post: 10-17-2013, 08:12 PM
  3. Test
    By Excel Fox in forum Den Of The Fox
    Replies: 0
    Last Post: 07-31-2013, 08:45 AM
  4. Replies: 4
    Last Post: 06-10-2013, 01:57 PM
  5. Test
    By Excel Fox in forum Word Help
    Replies: 0
    Last Post: 07-05-2011, 02:21 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •