Tuesday, 18 February 2020

Torque Dashboard formatter

Torque is an app that reads cars' electronic data.

Setting up the dashboard is a manual process which is tedious with many gauges and fat fingers.
This spreadsheet adapts Torque dashboards to phone screen size and gauge layout. The resulting .dash file can be loaded into Torque. The spreadsheet doesn't read or display data.

Read the Help manual sheet, then follow sheets 1 - 5 in order.
0 Manual. Everything you need to know is here.
1 Setup. To suit the phone screen
2 Paste an existing DASH file
3 Design a new layout of gauges
4 Builds new dashboard, don't even look at this
5 Copy new dashboard to Notepad

https://drive.google.com/drive/folders/1FKdsTt-de4XNbDth8lWylH_-EE2EOMoa?usp=sharing


Tuesday, 11 April 2017

America's Cup realtime viewer

Live display of America's Cup racing  

Thanks to Ken Milne, Mark Sheffield, Stan Honey, Russell Coutts and unknown others for making the data available.







Requires Excel Professional and internet connection. 32-bit only at present.


What is this about?

The America's Cup Event Authority broadcasts data from the racing yachts in realtime. 

This spreadsheet connects to the stream, deciphers some of the data and displays a simple graphic of the yachts' racing.

What does it show?

Simple 2D graphics of America's Cup yachts racing 
  • It is not video
  • Data is streamed direct from racing yachts over the internet at 5Hz
  • Data includes speeds, headings, latitude, longitude, boundaries, mark times, penalty calls
  • Yachts are drawn using their Lat/Long positions 
  • Yacht outlines are accurate within ~15cm
  • Zoom to course boundaries
  • Follow a chosen yacht
  • Commentary ticker
  • Coastline

Real or fake?

America's Cup Race Management have a website with documents governing the event as well as the streaming formats and a test program called ACView in Peli-Sim software. You could write your own... 

Links and thanks

Others have delved into the ACEA data stream and I learnt a lot trying to read their code.
https://github.com/douglasdecouto/ac34-ios
https://github.com/Ontropix/amcup-streaming
https://github.com/CircuitPeople/Americas-Cup-Data-Lib

PS
Yes, I know there are far better tools. I once hammered a nail with a spanner too. 

Monday, 3 April 2017

Automatic Continuous Calculator

Have you ever used Excel as a calculator?

Chances are that your calculations are similar each time.
Eg inverse or Average or hypotenuse or inch-to-mm.

Merely by selecting cells, this calculator is continually producing all of my common queries.








An extended version includes an instant XY plot, which can be instantly erased.


It's a very fast way to view data relationships, especially to check data entry.

Single cell
Units conversions
Inverse
Square root & squared
0.7 & 1.414 converts a square side to/from diagonal length.



Two Cells
Cells don't have to be contiguous,
Ratio
Count
Min/Max
Average
Sum
Product
Difference
Hypotenuse



Multiple Cells



Extended Version with Chart
All the standard features plus a simple XY plot. Good for quickly checking relationships, eg data entry errors.

Selecting two columns,


produces this:

Right-clicking the mouse deletes the lines immediately.
Columns don't have to be adjacent

Download StatusBarCalculator.xlsm

Download StatusBarCalculator with XY Chart.xlsm

Notes
  • Start by running InitializeCustomStatusBar, or InitializeCustomStatusBarChart for the chart version. 
  • Number of cells is limited to 20000. To change, edit AppStatusBar1_SheetSelectionChange.
  • Charting is limited to 3000 points. To change, edit AppStatusBar2_SheetSelectionChange.
  • Chart is not dynamic, so good practice is right-clicking the mouse to erase it immediately. It is drawn using Line shapes, not a real chart.
  • The status bar parts are modifications of work originally presented on Daily Dose of Excel, thanks!
  • The charting and shape delete part was modified from Daily Dose of Excel

Wednesday, 29 March 2017

GPS to KML - coloured by speed

Convert a GPS text file to a track that can be loaded into Google Earth, and coloured to reflect speed.
Requires Excel Professional to run VBA macro.


This code is setup for Velocitek GPS which is designed for sailing and motor sports. However it is simple to customise to any other GPS with data in text format. If there is demand for other formats, please comment.

Colours can represent another quantity, such as altitude.

Other GPS formats They need a new module to reformat data to these columns:
Column 1 is time, col 3 latitude DD.DDD, col 4 longitude DDD.DDDD, col 5 is speed, or other variable.

See separate page for macro code and notes.

Macro code is below. Paste into an Microsoft Excel module.

Run the Sub VCC2KML for Velocitek data opened as read-only Workbook..

General Notes
There are routines to cull the output with a minimum step between points. This can dramatically reduce filesize.

Fast & slow colour ranges are suggested by Max(speed) and Average(speed) - 2x StDev, but can be over-ridden.


Writing the KML file is a bottleneck and several subs are devoted to speeding this as much as I've managed to find via Google.


Open the VCC file in Excel as Read-only:



Run VCC2KML
Pick folder and filename for output.
Open KML in Google Earth.



Option Explicit
Public sKML As String
Public GradientColorName()
Public s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s6 As String
Sub VCC2KML()
Dim r As Range
Dim d
Dim rowDate As Long, colDate As Long
colDate = Cells.Find(What:="/CapturedTrack/Trackpoints/Trackpoint/@dateTime", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
'assumes Velocitek has time, h, Lat Lon spd continuous. Could be buggy
Set r = ActiveSheet.Cells(3, colDate).Resize(Application.CountA(Columns(colDate)) - 1, 5)
d = r.Value
Call GPSLLSpd2KML(d)
Set r = Nothing
End Sub
Sub GPSLLSpd2KML(d)
Dim dCull, dSpd
Dim r As Range
Dim colorIdx As Long
Dim lon As Double, lat As Double
Dim SOG As Double, time As String
Dim minSpdPlot As Double, maxSpdPlot As Double
Dim i As Long
Dim OrigNPts As Long, CulledNPts As Long
Dim maxDistBetwPts As Double
Dim minSpd As Double, maxSpd As Double, AvSpd As Double, SDSPd As Double
Dim title As String
Dim path As String, fnm As String
Const colTime As Long = 1 'unused
Const colLat As Long = 3 'DD.DDD
Const colLon As Long = 4 'DD.DDD
Const colSOG As Long = 5'this could be Altitude for example
Dim ccOffset As Long 'do not delete
Dim ccIncrement As Long
ccIncrement = 64 'fiddle with this to speed up or not. seems that between 2 and 1000 is OK
ccOffset = 0
sKML = vbNullString
s1 = "<Placemark>" & vbCr & " <styleUrl>#" 'to speed up output of placemarks
s2 = "</styleUrl>" & vbCr & " <Point>" & vbCr & " <coordinates>" & vbCr & " "
s3 = ",0" & vbCr & " </coordinates>" & vbCr & " </Point>" & vbCr & "</Placemark>" & vbCr
s4 = "<Placemark>" & vbCr & "<description>"
s5 = "</description>" & vbCr
s6 = " <styleUrl>#"
'
' <Placemark>
' <TimeStamp>
' <when>2007-01-14T21:05:02Z</when>
' </TimeStamp>
' <styleUrl>#paddle-a</styleUrl>
GradientColorName = Array("darkblue", "blue", "deepskyblue", "cyan", "MediumSpringGreen", "yellowgreen", "yellow", "orange", "OrangeRed", "red")
'coarsen track points
maxDistBetwPts = InputBox("Input min distance between pts, metres", "Cull redundant points", 3)
Call CullData(d, dCull, maxDistBetwPts, OrigNPts, CulledNPts)
ReDim dSpd(1 To UBound(dCull, 1), 1 To 1)
For i = 1 To UBound(dCull, 1)
dSpd(i, 1) = dCull(i, 5)
Next
Call SpdStats(dSpd, minSpd, maxSpd, AvSpd, SDSPd)
title = "Spds for Colour: " & _
"Min= " & Format(minSpd, "0.0") & " Max= " & Format(maxSpd, "0.0") & _
" Av= " & Format(AvSpd, "0.0") & " SD= " & Format(SDSPd, "0.0")
'default min Speed is Average-2*StDev
minSpdPlot = InputBox("Enter low speed for Blue", title, Format(findMax(AvSpd - 2 * SDSPd, 0), "0"))
maxSpdPlot = InputBox("Enter high speed for Red", title, Format(maxSpd, "0.0"))
Call outputLine3(sKML, "<?xml version=""1.0"" encoding=""UTF-8""?>", ccOffset, ccIncrement)
Call outputLine3(sKML, "<kml xmlns=""http://www.opengis.net/kml/2.2"">", ccOffset, ccIncrement)
Call outputLine3(sKML, "<Document>", ccOffset, ccIncrement)
Call setupStyleIcons(ccOffset, ccIncrement)
Dim m
m = Application.StatusBar
For i = 1 To UBound(dCull, 1)
Application.StatusBar = "writing KML " & Format(i / UBound(dCull, 1), "0" & "%") 'ADDS ~5% to time
SOG = CDbl(dCull(i, colSOG))
colorIdx = GradientColor(SOG, minSpdPlot, maxSpdPlot, 1, 10)
lon = CDbl(dCull(i, colLon))
lat = CDbl(dCull(i, colLat))
time = CStr(dCull(i, colTime))
Call makePlacemarkWithTimeAndSpeed(CStr(GradientColorName(colorIdx - 1)), lon, lat, time, SOG, ccOffset, ccIncrement)
Next
Application.StatusBar = m
Call outputLine3(sKML, "</Document>", ccOffset, ccIncrement)
Call outputLine3(sKML, "</kml>", ccOffset, ccIncrement)
Call writeKMLFile
End Sub
Sub CullData(arr1, cullArr, maxDist As Double, OrigNPts As Long, CulledNPts As Long)
Dim arrD1Cull()
Dim i As Long, j As Long, k As Long 'i-orig array, j - culled array, k - columns
Dim cullDist As Boolean
Dim cntDist As Long
Dim nRowsData As Long, nColsData As Long
Dim DistOrig2CullPt As Double
Const colLat As Long = 3
Const colLon As Long = 4
nRowsData = UBound(arr1, 1)
nColsData = UBound(arr1, 2)
ReDim arrD1Cull(1 To nRowsData, 1 To nColsData)
'initialise first row
For k = 1 To nColsData
arrD1Cull(1, k) = arr1(1, k)
Next
j = 1 'counter for culled array
cullDist = True
For i = 1 To nRowsData
DistOrig2CullPt = 1852 * PsnToRange(CDbl(arr1(i, colLat)), CDbl(arr1(i, colLon)), CDbl(arrD1Cull(j, colLat)), CDbl(arrD1Cull(j, colLon)))
If DistOrig2CullPt > maxDist Then
cullDist = False
cntDist = cntDist + 1 'culled points count
j = j + 1
For k = 1 To nColsData
arrD1Cull(j, k) = arr1(i, k)
Next
cullDist = True
End If
Next
'resize culledArray
ReDim cullArr(1 To cntDist, 1 To nColsData)
For i = 1 To cntDist
For j = 1 To nColsData
cullArr(i, j) = arrD1Cull(i, j)
Next
Next
OrigNPts = nRowsData
CulledNPts = OrigNPts - cntDist + 1
End Sub
Sub writeKMLFile()
Call TxtFileDriver(sKML, "kml")
End Sub
Function PsnToRange(P1LatDeg As Double, P1LonDeg As Double, P2LatDeg As Double, P2LonDeg As Double) ', VMag As VectorType)
'nm
Dim y As Double
Dim X As Double
Const rad As Double = 57.2957795130823
X = 60 * ModOneEighty(P2LonDeg - P1LonDeg) * Cos(P1LatDeg / rad)
y = 60 * ModOneEighty(P2LatDeg - P1LatDeg)
PsnToRange = Sqr(X * X + y * y)
End Function
Sub SpdStats(d, minSpd As Double, maxSpd As Double, AvSpd As Double, SDSPd As Double)
With Application.WorksheetFunction
minSpd = .Min(d)
maxSpd = .Max(d)
AvSpd = .Average(d)
SDSPd = .StDev(d)
End With
End Sub
Sub outputLine3(ByRef Dest As String, ByRef Source As String, ByRef ccOffset As Long, ByRef ccIncrement As Long)
Call Concat2(Dest, Source, ccOffset, ccIncrement)
End Sub
Sub Concat2(ByRef Dest As String, ByRef Source As String, ccOffset As Long, ccIncrement As Long)
'dim coffset as long put at top of calling Sub. say 1000 ? It increases string by this length in chunks
'Public ccOffset As Long 'do not delete
'Public ccIncrement As Long 'Number of characters to allocate every timePublic GradientColorName()
Dim L As Long
L = Len(Source)
If (ccOffset + L) >= Len(Dest) Then
If L > ccIncrement Then
Dest = Dest & Space$(L)
Else
Dest = Dest & Space$(ccIncrement)
End If
End If
Mid$(Dest, ccOffset + 1, L) = Source
ccOffset = ccOffset + L
Dest = Left$(Dest, ccOffset)
End Sub
Sub setupStyleIcons(ccOffset As Long, ccIncrement As Long)
Dim i As Long
Dim strColor As String
Dim strHexColor As String
For i = 1 To 10
strColor = GradientColorName(i - 1)
strHexColor = GradientColorHex(i - 1)
Call outputLine3(sKML, "<Style id=""" & strColor & """>", ccOffset, ccIncrement)
Call outputLine3(sKML, " <IconStyle>", ccOffset, ccIncrement)
Call outputLine3(sKML, " <color>" & strHexColor & "</color>", ccOffset, ccIncrement)
Call outputLine3(sKML, " <scale>.3</scale>", ccOffset, ccIncrement)
Call outputLine3(sKML, " <Icon>", ccOffset, ccIncrement)
Call outputLine3(sKML, " <href>http://maps.google.com/mapfiles/kml/pal2/icon26.png</href>", ccOffset, ccIncrement)
Call outputLine3(sKML, " </Icon>", ccOffset, ccIncrement)
Call outputLine3(sKML, " </IconStyle>", ccOffset, ccIncrement)
Call outputLine3(sKML, "</Style>", ccOffset, ccIncrement)
Next
End Sub
Sub makePlacemarkWithTimeAndSpeed(ByRef colorNm As String, lon As Double, lat As Double, _
time As String, SOG As Double, ccOffset As Long, ByRef ccIncrement As Long)
Call outputLine3(sKML, s4 & time & vbCr & SOG & s5, ccOffset, ccIncrement)
Call outputLine3(sKML, s6 & colorNm & s2 & lon & "," & lat & s3, ccOffset, ccIncrement)
End Sub
Sub TxtFileDriver(txt As String, Optional extension)
Dim path As String, fnm As String
Call Folder_Picker(path)
If Not IsMissing(extension) Then
fnm = InputBox("type filename")
fnm = fnm & "." & CStr(extension)
Else
fnm = InputBox("type filename with extension")
End If
Call writeTxtFile(txt, path, fnm)
End Sub
Sub Folder_Picker(fldr As String)
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.path & "\"
.Show
If .SelectedItems.Count = 0 Then GoTo 1
fldr = .SelectedItems(1)
fldr = fldr & "\"
1 End With
End Sub
Sub writeTxtFile(txt As String, path As String, fnm As String, Optional extension) 'path As String, fnm As String)
Dim fs, A
fnm = makePathFileExt(path, fnm)
Set fs = CreateObject("Scripting.FileSystemObject")
Set A = fs.CreateTextFile(fnm, True, True)
A.WriteLine (txt)
Close
End Sub
Function findMax(A As Double, b As Double) As Double
findMax = -(A > b) * A + -(b >= A) * b
End Function
Function GradientColor(val As Double, lowVal As Double, highVal As Double, _
lowColorIndex As Long, NumbrColors As Long) As Long
Dim ratio As Single
ratio = (val - lowVal) / (highVal - lowVal)
If ratio > 1 Then ratio = 1
GradientColor = Int(ratio * (NumbrColors - 1)) + lowColorIndex
If GradientColor > NumbrColors + lowColorIndex Then GradientColor = NumbrColors + lowColorIndex 'saturated max
If GradientColor < lowColorIndex Then GradientColor = lowColorIndex 'saturated min
End Function
Function ModThreeSixty(A As Double) As Double
ModThreeSixty = A - 360 * Int(A / 360)
End Function
Function ModOneEighty(A As Double) As Double
'final range value is between
' 180 and -180 degrees
ModOneEighty = ModThreeSixty(A + 180) - 180
End Function
Function GradientColorHex(colorIdx As Long) As String 'changes colors 16 to 32 from blue to red
' Colours based on Nile/Hairyears thermal gradient scale
Dim i As Long
Dim arr() As Variant
i = colorIdx
' arr = Array("darkblue", "blue", "deepskyblue", "cyan", "MediumSpringGreen", "yellowgreen", "yellow", "orange", "OrangeRed", "red")
arr = Array("ff8b0000", "ffff0000", "ffffbf00", "ffffff00", "ff9afa00", "ff32cd9a", "ff00ffff", "ff00a5ff", "ff0045ff", "ff0000ff")
GradientColorHex = arr(i)
End Function
Function makePathFileExt(path As String, fnm As String, Optional extension) As String
If Not IsMissing(extension) Then
fnm = fnm & "." & extension
ElseIf Mid(fnm, Len(fnm) - 3, 1) = "." Then
'fnm=fnm 'assumes .xxx format
Else
fnm = fnm & "." & "txt"
End If
makePathFileExt = path & fnm
End Function
view raw GPS to KML hosted with ❤ by GitHub