Create complex polygon - determine if coords intersect

[Legacy 98055]

I am creating an automatic, mobile logging system utilizing a GPS. The US Census Bureau provides approximate coordinates for each US zipcode. An example of "45252", which is my home zipcode is below...

-84.6298613426565 39.2773019382716
-84.6303470000000 39.3120560000000
-84.6294240000000 39.3104500000000
-84.6333240000000 39.3090500000000
-84.6342240000000 39.3091500000000
-84.6372480000000 39.3062570000000
-84.6277480000000 39.3043570000000
-84.6211470000000 39.3024570000000
-84.6183470000000 39.3001570000000
-84.6110470000000 39.2924570000000
-84.6072470000000 39.2895570000000
-84.6056470000000 39.2865570000000
-84.6040470000000 39.2811570000000
-84.6025470000000 39.2700570000000
-84.6041470000000 39.2638570000000
-84.6038470000000 39.2622570000000
-84.6004460000000 39.2563570000000
-84.6026460000000 39.2550570000000
-84.6215470000000 39.2401570000000
-84.6260470000000 39.2376570000000
-84.6298470000000 39.2327580000000
-84.6298470000000 39.2327580000000
-84.6370470000000 39.2348570000000
-84.6438470000000 39.2396570000000
-84.6472470000000 39.2409570000000
-84.6524470000000 39.2471570000000
-84.6584380000000 39.2508330000000
-84.6617480000000 39.2566570000000
-84.6630550000000 39.2601090000000
-84.6629480000000 39.2615570000000
-84.6625740000000 39.2617050000000
-84.6625740000000 39.2617050000000
-84.6597600000000 39.2616000000000
-84.6554380000000 39.2644080000000
-84.6547220000000 39.2665350000000
-84.6584480000000 39.2715570000000
-84.6549030000000 39.2806030000000
-84.6529480000000 39.2872570000000
-84.6534480000000 39.2892570000000
-84.6602480000000 39.2885570000000
-84.6645480000000 39.2920570000000
-84.6643480000000 39.2962570000000
-84.6606510000000 39.2989360000000
-84.6571170000000 39.2998400000000
-84.6506930000000 39.2990440000000
-84.6465830000000 39.3003130000000
-84.6424770000000 39.3030640000000
-84.6377060000000 39.3098200000000
-84.6304060000000 39.3120460000000
-84.6304060000000 39.3120460000000
-84.6303470000000 39.3120560000000

These sets of Longitute and Latitude coords define a boundary for my zip code. What I need to do is create a complex polygon with the above coords and then, feeding a function a Longitute and Latitude, determine if that given global position falls within my polygon (zip code boundary).

For example:

Longitude: -84.6197
Latitude: 39.2947

Will fall within the above polygon and my function would return true.

Any help on this one??? Please!

 

[doriangrey]

Hi Tom, Damon

I implemented Damon's algorithm directly in vba, just calculate the angles, take the difference between consecutive points and add....

Please copy of Excel workbook file of this polygon intersect algorithm

 

[pgc01]

Sorry, this way 10 years ago! No excel workbook.

 

[Rick Rothstein]

Please copy of Excel workbook file of this polygon intersect algorithm

You should be able to adapt the code I posted in my mini-blog here to do what you want...

http://www.excelfox.com/forum/showthread.php/1579-Test-Whether-A-Point-Is-In-A-Polygon-Or-Not

 

[HarryS]

'I Found this OK

Option Explicit
' windows api guide
Declare Function CreateRectRgn& Lib "gdi32" (ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)
Declare Function CombineRgn& Lib "gdi32" (ByVal hDestRgn&, ByVal hSrcRgn1&, ByVal hSrcRgn2&, ByVal nCombineMode&)
Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
 Declare Function CreatePolygonRgn& Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount&, ByVal nPolyFillMode&)
 Declare Function CreateEllipticRgn& Lib "gdi32" (ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)
 Declare Function PtInRegion& Lib "gdi32.dll" (ByVal hRgn&, ByVal x&, ByVal y&)
Declare Function RectInRegion& Lib "gdi32.dll" (ByVal hRgn&, lpRect As RECT)
Declare Function GetRgnBox Lib "gdi32.dll" (ByVal hRgn As Long, lpRect As RECT) As Long

Type POINTAPI  ' Point or Line vector
x As Long
y As Long
End Type
Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Public Const RGN_AND = 1    'Calculates the intersection of the two source areas (the area they have in common.)
Public Const RGN_OR = 2    'Calculates the union of the two areas (the area either occupy.)
Public Const RGN_XOR = 3    'Takes the union of the two areas and subtracts their intersecti
Public Const RGN_DIFF = 4    'difference this subtracts the second region from the first
Public Const RGN_COPY = 5    'Returns a copy of the first region, a clone region.
Public Const RGN_MIN = RGN_AND
Public Const RGN_MAX = RGN_COPY
Const ERROR = 0
Const NULLREGION = 1
Const SIMPLEREGION = 2
Const COMPLEXREGION = 3

Public wPA() As POINTAPI
Public AUR&, WUR&, WI&, wPAPI As POINTAPI
Public Const XYOff = 32&, XYFac& = 65536 '16384'32768'262144'1048576
Public RegLook&(), NumReg&, Wsa$()
Sub FindPolyCodes(wShtNa$)
Dim Ri&, CI&, FoundIT As Boolean, CombRegTy&
'
' get post code regions '
'
Dim RaPCD As Range: Set RaPCD = Sheets(wShtNa).Range("c11").CurrentRegion
Dim RaPts As Range: Set RaPts = Sheets("SomeLots").Range("c11").CurrentRegion
NumReg = RaPCD.Rows.Count
ReDim RegLook(NumReg)
RegLook(0) = CreateRectRgn(0, 0, 0, 0) ' Use (0) as combined region ''' needs  initialization
For Ri = 1 To NumReg
 Wsa = Split(RaPCD(Ri, 2), ",")
 WUR = UBound(Wsa)
  AUR = WUR \ 2 - 1
  ReDim wPA(AUR)
  
 For CI = 0 To AUR
 wPA(CI).x = Wsa(2 * CI) * XYFac
 wPA(CI).y = Wsa(2 * CI + 1) * XYFac
 Next CI
RegLook(Ri) = CreatePolygonRgn&(wPA(1), AUR, 1)
Next Ri
'
'  post code regions in
'  check points in what region
'
For Ri = 1 To RaPts.Rows.Count
'For Ri = 1 To RaPts.Rows.Count
'MsgBox "ss" & Ri

wPAPI.x = RaPts(Ri, 2) * XYFac
wPAPI.y = RaPts(Ri, 1) * XYFac
FoundIT = False: WI = 0
While Not FoundIT And WI < NumReg
WI = WI + 1
FoundIT = PtInRegion(RegLook(WI), wPAPI.x, wPAPI.y)
Wend
If FoundIT Then
RaPts(Ri, 6) = RaPCD(WI, 1) '
'MsgBox Ri & RaPCD(WI, 1) & RaPts(Ri, 5)
End If

Next Ri

For Ri = 1 To NumReg
DeleteObject RegLook(Ri)
Next Ri

End Sub

Sub DoCombine()
 RegA = CreatePolygonRgn&(wPA(1), AUR, 1)
 RegB = CreatePolygonRgn&(wPb(1), BUr, 1)
 
 RegC = CreatePolygonRgn&(wPc(1), BUr, 1)
'CombReg = CreatePolygonRgn&(wPc(1), BUr, 1)
 'hXorRgn = CreateRectRgn(0, 0, 0, 0)  ' meaningless initialization
CombReg = CreateRectRgn(0, 0, 0, 0)  ' meaningless initialization
 [b2] = CombineRgn(CombReg, RegB, RegC, RGN_AND)
 'RickForm.SetReg CombReg
  ' RickForm.Show False
 [b3] = CombineRgn(CombReg, RegA, RegB, RGN_AND)
 
[b4] = CombineRgn(CombReg, RegB, RegC, RGN_AND)
 
 
 [b5] = CombineRgn(CombReg, RegA, RegC, RGN_AND)
  
 

End Sub


Sub TestPolyInPoly(RaPA As Range, RaPB As Range, RaPC As Range)
Dim PAi&, PBi&, PCi&, Ri&
 
 AUR = RaPA.Rows.Count
 ReDim wPA(AUR)
 For Ri = 1 To AUR
 wPA(Ri).x = RaPA(Ri, 1) * XYFac + XYOff
 wPA(Ri).y = RaPA(Ri, 2) * XYFac + XYOff
 Next Ri
 
  BUr = RaPB.Rows.Count
 ReDim wPb(BUr)
 For Ri = 1 To BUr
 wPb(Ri).x = RaPB(Ri, 1) * XYFac + XYOff
 wPb(Ri).y = RaPB(Ri, 2) * XYFac + XYOff
 Next Ri
  CUr = RaPC.Rows.Count
 ReDim wPc(CUr)
 For Ri = 1 To CUr
 wPc(Ri).x = RaPC(Ri, 1) * XYFac + XYOff
 wPc(Ri).y = RaPC(Ri, 2) * XYFac + XYOff
 Next Ri
 DoCombine
 
End Sub

the xyoff is useless
use XYFac as powers of 2 as 2^17

the accuracy from 65536 is about 1.7 met

This halves or doubles with increasing the powers of 2
at 65536 takes about .2 sec to check 2000 points in 20 localities

of course more accuracy less speed
big accuracy .. not fit in normal long

big difference in speed by having the regions to be searched in an array
that is pre calculated
with exit when found

The predefining of the region for combine ( even as a 0,0,0,0, dummy)
IS NEEDED for combine to work


above using points as lat Lng
using polygons as CSV of LNG,Lat,lng,lat,lng,lat
NOT repeat of first point to close poly

 

[doriangrey]

thank you very mutch all people!