GPXファイルの時間を変更する方法

2021年12月18日2021年12月29日

1. GPXファイルの時間変更ツール

　GPXファイルの時間変更ツール ＆ GPSログの欠落補完（Windows PC用)

　GPSログ(GPXファイル)の時間を書き換えるツール(スクリプト)です。このスクリプトは元のファイルには何の変更もせず、時間を変更したファイルを新たに作ります。

引用元：ヤマレコ

'-----------スクリプト　GPXファイルの時間変更　2016/11/13 v3.0 --------------------------

Option explicit
Const strTitl = "GPX time change"
Const intTC = -9 '標準時間係数　グリニッジ標準時は-9, 日本ローカル時間は0
Const dblVelUpL = 0.85 '平地を1とした登りの速度比率
Const dblVelDnL = 1.15 '平地を1とした下りの速度比率
Const dblVelUpH = 0.5 '平地を1とした急な登りの速度比率
Const dblVelDnH = 0.8 '平地を1とした急な下りの速度比率
Const dblUpTh1 = 0.01 '傾斜係数 1m/100m を登りとする
Const dblUpTh2 = 0.5 '傾斜係数 50m/100m を急な登りとする
Const dblDnTh1 = -0.01 '傾斜係数 -1m/100m を下りとする
Const dblDnTh2 = -0.5 '傾斜係数 -50m/100m を急な下りとする

If WScript.Arguments.Count = 0 Then
MsgBox "Drop the GPX file.",,strTitl
WScript.Quit
End If
'スクリプトのあるフォルダを作業フォルダにしてFileSystemObjectの取得
Dim strScriptPath, objFSO, strArg, objDrpFile
strScriptPath = Replace( Wscript.ScriptFullName, Wscript.ScriptName, "")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
strArg = WScript.Arguments(0)
If objFSO.FileExists(strArg) Then 'ファイルならFileオブジェクト取得
On Error Resume Next
Set objDrpFile = objFSO.GetFile(strArg)
If Err.Number <> 0 Then Set objDrpFile = Nothing
On Error Goto 0
Else
Set objDrpFile = Nothing
End If
If objDrpFile Is Nothing Then
MsgBox "It is not a file.",,strTitl
WScript.Quit '終了
End If

Dim objInFile, objOutFile, strInFilePath, strOutFilePath
Set objInFile = objFSO.OpenTextFile(objDrpFile.Path, 1)
Dim intI, intJ, strBuf
intI = 0: intJ = 0
For intI = 1 to 3
strBuf = objInFile.ReadLine
If InStr(strBuf, "gpx") <> 0 Then intJ = 1
Next
If intJ <> 1 Then
MsgBox "No GPX file was dropped.",,strTitl
objInFile.Close
WScript.Quit '終了
End if

'=========最初にファイルを全部読みこみ、距離、昇降値を集計==============
Dim strOutLine
Dim strPrevIdo, strPrevKeido, dblPrevEle, strCurIdo, strCurKeido, dblCurEle
'最初のtrkptを読み込んで初期値とする
Call get_lon_lat_ele_val 'trkptから緯度/軽度/標高を抽出
strPrevIdo = strCurIdo : strPrevKeido = strCurKeido : dblPrevEle = dblCurEle
'距離、昇降値の集計
Dim dblPtDis, dblPtEle, dblDisAll, dblUpDisL, dblUpDisH, dblDwnDisL, dblDwnDisH, dblEvnDis
dblDisAll=0 : dblUpDisL=0 : dblUpDisH=0 : dblDwnDisL=0 : dblDwnDisH=0 : dblEvnDis=0
Dim dblBalo
Do Until InStr(strBuf, "</trkseg>")
Call get_lon_lat_ele_val
'前のポイントからの距離と標高差を求める
dblPtDis = DistanceCaluc(strPrevIdo, strPrevKeido, strCurIdo, strCurKeido)
dblPtEle = dblCurEle - dblPrevEle
dblDisAll = dblDisAll + dblPtDis
'標高差によって距離を集計(振り分け)する
If dblPtDis = 0 Then
dblBalo = 0
Else
dblBalo = dblPtEle/dblPtDis
End If
If dblBalo > dblUpTh2 Then dblUpDisH = dblUpDisH + dblPtDis
If (dblUpTh2 > dblBalo) and (dblBalo > dblUpTh1) Then dblUpDisL = dblUpDisL + dblPtDis
If (dblDnth1 < dblBalo) and (dblBalo < dblUpTh1) Then dblEvnDis = dblEvnDis + dblPtDis
If (dblDnth2 < dblBalo) and (dblBalo < dblDnth1) Then dblDwnDisL = dblDwnDisL + dblPtDis
If dblBalo < dblDnth2 Then dblDwnDisH = dblDwnDisH + dblPtDis
strPrevIdo = strCurIdo : strPrevKeido = strCurKeido : dblPrevEle = dblCurEle
Loop
objInFile.Close

'============再度ファイルを読み込み時間変更==========================
Dim strStrTim, strEndTim, strTimBuf, dblTimAll, strDate
strDate =InputBox ("Input the date. (yyyy-mm-dd)", strTitl, "20yy-mm-dd")
strStrTim = InputBox ("Input the departure time. (hh:mm)", strTitl, "hh:mm")
strEndTim = InputBox ("Input the arrival time. (hh:mm)", strTitl, "hh:mm")
On Error Resume next
strStrTim = strDate & " " & strStrTim : strEndTim = strDate & " " & strEndTim
strStrTim = DateAdd("h", intTC, strStrTim )
strEndTim = DateAdd("h", intTC, strEndTim )
dblTimAll = DateDiff("s", strStrTim, strEndTim)
On Error Goto 0
If dblTimAll < 1 Then
MsgBox "Input value is not correct.",,strTitl
WScript.Quit
End If
If InStr(strStrTim, ":") = 0 Then strStrTim = strStrTim & " 00:00:00"
'出力ファイル準備
strOutFilePath = strScriptPath + objFSO.GetBaseName(objDrpFile.Name) + "_Change.gpx"
If objFSO.FileExists(strOutFilePath) Then
If MsgBox ("Same name file is existing. Overwrite?", vbYESNO,strTitl) = vbNO Then
Wscript.Quit
End If
objFSO.DeleteFile(strOutFilePath)
End If
Set objOutFile = objFSO.OpenTextFile(strOutFilePath, 8, True, 0)
'入力ファイル再オープン
Set objInFile = objFSO.OpenTextFile(objDrpFile.Path, 1)
'最初のtrkptまでを出力ファイルにコピー & スタート点の緯度/軽度初期値の設定
Do
strBuf = ObjInFile.ReadLine
If InStr(strBuf, "<trkpt") = 0 Then
If InStr(strBuf, "<name>") And InStr(strBuf, "</name>") = 0 Then 'UTF-8文字化け対策
strBuf = Replace(strBuf, "/name", "</name")
End If
objOutFile.WriteLine strBuf
End If
Loop Until InStr(strBuf, "<trkpt")

Dim strBuf2
Call get_lon_lat_str
If InStr(strBuf, "</trkpt>") Then 'ヤマプラ/ヤマレコ ファイル
intElbgn = InStr(strBuf, "<ele>")
intElend = InStr(strBuf, "</ele>")
dblCurEle = CDbl(Mid(strBuf, intElbgn + 5, intElend - intElbgn - 5))
strBuf2 = Left(strBuf, InStr(strBuf, "</ele>") + 5)
strStrTim = Replace(strStrTim, "/", "-")
strBuf = Replace(strStrTim, " ", "T")
strBuf2 = strBuf2 & "<time>" & strBuf & "Z</time>"
strBuf = strBuf2 & "</trkpt>"
objOutFile.WriteLine strBuf
Else 'カシミール ファイル
objOutFile.WriteLine strBuf
Do '<ele>から</trkpt>までの読み込みと書き出しループ
strBuf = ObjInFile.ReadLine
If InStr(strBuf, "<ele>") Then
intElbgn = InStr(strBuf, "<ele>")
intElend = InStr(strBuf, "</ele>")
dblCurEle = CDbl(Mid(strBuf, intElbgn + 5, intElend - intElbgn - 5))
End If
If InStr(strBuf, "<time>") Then
strStrTim = Replace(strStrTim, "/", "-")
strBuf2 = Replace(strStrTim, " ", "T")
strBuf = "<time>" & strBuf2 & "Z</time>"
End If
objOutFile.WriteLine strBuf
Loop Until InStr(strBuf, "</trkpt>")
End If
strPrevIdo = strCurIdo : strPrevKeido = strCurKeido : dblPtEle = dblCurEle

'--------------時間変更---------------------
Dim intAddTim, dblVupH, dblVupL, dblVdnH, dblVdnL, dblVelEvn, strTimFmt
dblVelEvn=(dblUpDisH / dblVelUpH + dblUpDisL / dblVelUpL + dblEvnDis + dblDwnDisL / dblVelDnL + dblDwnDisH / dblVelDnH) / dblTimAll
dblVupH = dblVelEvn * dblVelUpH
dblVupL = dblVelEvn * dblVelUpL
dblVdnL = dblVelEvn * dblVelDnL
dblVdnH = dblVelEvn * dblVelDnH
Do
strBuf = ObjInFile.ReadLine
If InStr(strBuf, "<trkpt") Then
Call get_lon_lat_str
dblPtDis = DistanceCaluc(strPrevIdo, strPrevKeido, strCurIdo, strCurKeido)
End If
If InStr(strBuf, "</trkpt>") Then 'ヤマプラ/ヤマレコ ファイル
intElbgn = InStr(strBuf, "<ele>")
intElend = InStr(strBuf, "</ele>")
dblCurEle = CDbl(Mid(strBuf, intElbgn + 5, intElend - intElbgn - 5))
dblPtEle = dblCurEle - dblPrevEle
Call add_tim_calc
strBuf2 = Left(strBuf, InStr(strBuf, "</ele>") + 5)
strBuf = strBuf2 & strTimFmt & "</trkpt>"
objOutFile.WriteLine strBuf
Else 'カシミール ファイル
If InStr(strBuf, "<trkpt") Then
objOutFile.WriteLine strBuf
Do '<ele>から</trkpt>までの読み込みと書き出しループ
strBuf = ObjInFile.ReadLine
If InStr(strBuf, "<ele>") Then
intElbgn = InStr(strBuf, "<ele>")
intElend = InStr(strBuf, "</ele>")
dblCurEle = CDbl(Mid(strBuf, intElbgn + 5, intElend - intElbgn - 5))
dblPtEle = dblCurEle - dblPrevEle
End If
If InStr(strBuf, "<time>") Then
Call add_tim_calc
strBuf = strTimFmt
End If
objOutFile.WriteLine strBuf
Loop Until InStr(strBuf, "</trkpt>")
End If
End If
strPrevIdo = strCurIdo : strPrevKeido = strCurKeido : dblPrevEle = dblCurEle
Loop Until InStr(strBuf, "</trkseg>")

objOutFile.WriteLine strBuf
If InStr(strBuf, "</trk>") = 0 Then
strBuf = "</trk>"
objOutFile.WriteLine strBuf
End If
strBuf = "</gpx>"
objOutFile.WriteLine strBuf

objInFile.Close
objOutFile.Close
MsgBox "Finished",,strTitl
Wscript.Quit

'=================関数、サブルーチン==================

'2つの緯度、経度間の距離を計算する関数 (ヒュベニの公式を使用）
Function DistanceCaluc(strIdo1, strKeido1, strIdo2, strKeido2)
Dim ido1, ido2, keido1, keido2
Dim P, dP, dR, M, N
Const pai = 3.141592
ido1 = CDbl(strIdo1) : keido1= CDbl(strKeido1)
ido2 = CDbl(strIdo2) : keido2 = CDbl(strKeido2)
P = (ido1 + ido2) / 2 * pai / 180
dP = (ido1 - ido2) * pai / 180
dR = (keido1 - keido2) * pai / 180
M = 6334834 / Sqr((1 - 0.006674 * Sin(P) * Sin(P))^3)
N = 6377397 / Sqr(1 - 0.006674 * Sin(P) * Sin(P))
DistanceCaluc = Sqr((M * dP) * (M * dP) + (N * Cos(P) * dR) * (N * Cos(P) * dR))
End Function

'</trkpt>行までを読み込み緯度/軽度/標高を抽出するサブルーチン : 返数=strCurIdo, strCurKeido, dblCurEle
Dim intElbgn, intElend
Sub get_lon_lat_ele_val
Do
strBuf = ObjInFile.ReadLine '1行読み込む
If InStr(strBuf, "<trkpt") Then
Call get_lon_lat_str
End If
If InStr(strBuf, "<ele>") Then
intElbgn = InStr(strBuf, "<ele>")
intElend = InStr(strBuf, "</ele>")
dblCurEle = CDbl(Mid(strBuf, intElbgn + 5, intElend - intElbgn - 5))
End If
If InStr(strBuf, "</trkseg>") Then
strBuf = "</trkpt></trkseg>"
End If
Loop Until InStr(strBuf, "</trkpt>")
End Sub

'文字列(strBuf)から緯度/軽度を抽出するサブルーチン : 引数=strBuf 返数=strCurIdo, strCurKeido
Dim strTmp, strArr
Dim intA, intB
Sub get_lon_lat_str
intA = InStr(strBuf, "=" ) + 2
intB = InStr(strBuf, ">") - 1 - intA
strTmp = Mid(strBuf, intA, intB)
strTmp = Replace(strTmp, chr(34), "")
strTmp = Replace(strTmp, chr(20), "")
If InStr(strTmp, "lon=") Then
strArr = Split(strTmp, "lon=")
strCurIdo = strArr(0)
strCurKeido = strArr(1)
Else
strArr = Split(strTmp, "lat=")
strCurIdo = strArr(1)
strCurKeido = strArr(0)
End If
End sub

'前trkptと現trkptの距離/標高差によって加算時間を求め、現trkptの時間を決めるサブルーチン : 引数=dblPtEle, dblPtDis, strStrTim 返数=strTimFmt
Dim dblVelCur
Sub add_tim_calc
If dblPtDis = 0 Then
dblBalo = 0
Else
dblBalo = dblPtEle/dblPtDis
End If
'昇降傾斜によって速度を決める
If dblBalo > dblUpTh2 Then dblVelCur = dblVupH
If (dblUpTh2 > dblBalo) and (dblBalo > dblUpTh1) Then dblVelCur = dblVupL
If (dblDnth1 < dblBalo) and (dblBalo < dblUpTh1) Then dblVelCur = dblVelEvn
If (dblDnth2 < dblBalo) and (dblBalo < dblDnth1) Then dblVelCur = dblVdnL
If dblBalo < dblDnth2 Then dblVelCur = dblVdnH
intAddTim = Round(dblPtDis/dblVelCur, 0) '距離/速度
strStrTim = DateAdd("s", intAddTim, strStrTim ) 'strStrTim = Time at current point.
If InStr(strStrTim, ":") = 0 Then strStrTim = strStrTim & " 00:00:00"
strStrTim = Replace(strStrTim, "/", "-")
strTimFmt = Replace(strStrTim, " ", "T")
strTimFmt = "<time>" & strTimFmt & "Z</time>"
End sub

2. GPXファイルの時間変更ツールの作成要領

「ヤマレコ」に掲載されている「VBSスクリプト」を、メモ帳にコピーして保存（名前は任意で良い）した後、ファイルの拡張子を「.txt」から「.vbs」に変更する。

このファイルをダブルクリックして、「Drop the GPX file.」というメッセージが表示されれば、動作OK。

3. GPXファイルの時間変更ツールの使い方

日時を変更したい【gpx】ファイルを、「.vbs」ファイルの上にドロップするすることで、「.vbs」が起動される。

最初に日付の入力が求められるので、変更したい「日付」を入力する。

次に、出発時間を入力する。

最後に、到着時間を入力する。

これで、日時の変更が完了する。

「.vbs」ファイルがあるフォルダーに、日時が変更された「xxxxx_Change.gpx」ファイルが作成される。

4. カシミール3D で使ってみる

カシミール3D で、日時を変更した「xxxxx_Change.gpx」ファイルのトラックポイント一覧を表示して見ると、入力した日時に変更されている。

日付が「2021/12/17」のトラックと「2021/12/18」に変更したトラックを【接続】して見る。

以上。
(2020.12.18)