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.




Waypoints.xlsx
https://developers.google.com/maps/d...ylinealgorithm

[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