google poly line encoding in excelR

[samuelimtech]

Hi all,

Im sure some of you guys will find this problem/challenge quite interesting and i'm sure that itll be plenty in useful for the answer/solution to be out there on the web.
the problem is i would like excel to code me a google poly-line. there are instructions of how to do this in the link at the bottom.
attached is a spread sheet with a route and if someone would be kind enough to take a look and see if they can get the spreadsheet to work out the polyline code for each point relative to the previous that would be perfect.




15277
https://developers.google.com/maps/documentation/utilities/polylinealgorithm

[Paul_Hossler]

This seems to match the results in your link (always a good thing)

The one thing I don't like about the way I did it was the Mid() on the string. It's be faster to stay in a 'binary' mode, but that would require AND's and Shifts




Option Explicit
'https://developers.google.com/maps/documentation/utilities/polylinealgorithm
'1.Take the initial signed value: -179.9832104
'2.Take the decimal value and multiply it by 1e5, rounding the result: -17998321
'3.Convert the decimal value to binary. Note that a negative value must be calculated using
' its two's complement by inverting the binary value and adding one to the result:
' 00000001 00010010 10100001 11110001
' 11111110 11101101 01011110 00001110
' 11111110 11101101 01011110 00001111
'4.Left-shift the binary value one bit: 11111101 11011010 10111100 00011110
'5.If the original decimal value is negative, invert this encoding:
' 00000010 00100101 01000011 11100001
'6.Break the binary value out into 5-bit chunks (starting from the right hand side):
' 00001 00010 01010 10000 11111 00001
'7.Place the 5-bit chunks into reverse order:
' 00001 11111 10000 01010 00010 00001
'8.OR each value with 0x20 if another bit chunk follows:
' 100001 111111 110000 101010 100010 000001
'9.Convert each value to decimal:
' 33 63 48 42 34 1
'10.Add 63 to each value:
' 96 126 111 105 97 64
'11.Convert each value to its ASCII equivalent:
' `~oia@

Sub drv()
MsgBox GooglePolyline(-179.9832104)
MsgBox GooglePolyline(38.5)
MsgBox GooglePolyline(-120.2)
End Sub

Function GooglePolyline(N As Double) As String
Dim N1 As Double
Dim L As Long, i As Long
Dim B As String, Poly As String
Dim S(1 To 6) As String
Dim D(1 To 6) As String

N1 = N ' 1
N1 = N1 * 100000# ' 2
L = Round(N1, 0)
L = L * 2 ' 4
If N < 0# Then
L = L Xor &HFFFFFFFF ' 5
End If
B = pvtLongToBinary(L) ' 3
S(1) = Mid(B, 28, 5) ' 6,7
S(2) = Mid(B, 23, 5)
S(3) = Mid(B, 18, 5)
S(4) = Mid(B, 13, 5)
S(5) = Mid(B, 8, 5)
S(6) = Mid(B, 3, 5)

For i = 1 To 6
L = pvtBinaryToLong(S(i)) ' 9
If i <> 6 Then L = L Or &H20 ' 8
L = L + 63 ' 10
Poly = Poly & Chr(L) ' 11
Next i
GooglePolyline = Poly
End Function

Private Function pvtLongToBinary(L As Long) As String
Const maxpower = 30 ' Maximum number of binary digits supported.
Dim B As String
Dim i As Long

If L < 0 Then B = B + "1" Else B = B + "0"
For i = maxpower To 0 Step -1
If L And (2 ^ i) Then ' Use the logical "AND" operator.
B = B + "1"
Else
B = B + "0"
End If
Next
pvtLongToBinary = B
End Function
Private Function pvtBinaryToLong(B As String) As Long
Dim i As Long
For i = 0 To Len(B) - 1
pvtBinaryToLong = pvtBinaryToLong + Val(Mid(B, Len(B) - i, 1)) * 2 ^ i
Next
End Function

[samuelimtech]

absolutely fantastic thank you

[Paul_Hossler]

Check it out really well

I was playing around with some AND and RightShift logic to see about not having to play with the strings like that

I'm sure it can be improved / replaced so maybe someone else will have some more ideas