ルートデータ解説の最終回は、ＶＢＳによるＧＰＸデータの加工について掲載します。
日本一周等の大量データを「ルートラボ」で扱う場合、データ量の制限が発生する。
「ルートラボ」では、地点数の上限が8000地点(ポイント)に制限される。
fieldAccess等のＧＰＳ記録アプリを利用すると数十秒毎や数百ｍ移動毎に緯度経度
の地点データが記録される。これを累積することで移動記録が数値化される。
fieldAccessで記録した場合、自動車、自転車、徒歩等で異なるが、2～5日の移動、
又は100km～500km程の移動で制限を超えそう。
これに対する選択肢は、8000地点以内でデータを分割する、地点数を間引く、どちらか。
昨年はネットから「gpx2jsgi」というソフトを利用し、間引方法でルートラボにデータ記録。
（参考：gpx2jsgiの所在地は[anineco.nyanta.jp/gpx2jsgi.html]）
今年は、昨年利用したソフトに頼らず、自力で間引方法をしてみようと一念発起。
解決すべき課題は２つ。
第一は、１日単位で記録したデータの数十日分を統合すること。
第二は、統合したデータ（数万地点データ）を8000地点以内に間引くこと。
この課題解決のため、VBScriptと言うプログラム作成ツールを利用。
VBScriptは手作業だと大変な作業を効率化するWindows上で利用できるツール。
第一の課題解決のために「ファイル統合.vbs」、
第二の課題解決のために「ポイント間引.vbs」というプログラムを作成。
プログラムリストは末尾に掲載する。
これを利用する場合は、各リストをメモ帳等にコピーし、上記の名前で保存する。
その後、Windows上でダブルクリックで実行すると、ソフトが利用できる。
「ファイル統合.vbs」ソフトの使い方
ソフトを実行する前に統合したいgpxファイルを任意のフォルダにまとめる。
ソフトを実行するとgpxfileのあるフォルダを尋ねてくるのでフォルダを指定する。
後はソフトに任せるとgpxfileのフォルダに統合file.txtというファイルを作成。
なおソフト実行の前にプログラム19行目「Const～」の出力ファイルのドライブや
フォルダ名は各自のＰＣ環境に合わせ書き換えが必要。
「ポイント間引.vbs」ソフトの使い方
このソフトは２地点の緯度・経度の差が一定以上超えたデータのみ抽出する。
緯度1度は約111km。経度1度は75～90km。
例えば500m移動毎のデータを抽出する場合は、緯度で0.0045度、経度で0.006度
の差があるデータを抜き出せば良い。
プログラムでは緯度0.006、経度0.007に設定しており、適宜変更して利用できる。
なおソフト実行の前にプログラム21、22行目「Const～」の入出力ファイルのドライブ
やフォルダ名は各自のＰＣ環境に合わせ書き換えが必要。
入力ファイル名はファイル統合.vbsの出力ファイル名（既定名は統合file.txt）と整合。
ＶＢＳを使ったプログラムについて
（プログラムに興味のある人以外には、理解困難な話だと思います。）
先ずVBScriptについて簡単解説。
VBScript（以下ＶＢＳ）とは、ビジュアルベーシックスクリプトの略で、エクセルマクロでお馴染みのVBA（ビジュアルベーシックアプリケーション）と兄弟の関係。
ＶＢＡはエクセル上で動くプログラム。ＶＢＳはWindows上で動くプログラム。
大昔にはBasicという言語でプログラムを作りＰＣを操作していたが、ＶＢＳも同様に
プログラムを作ることでＰＣに命令しＰＣが仕事を代行する。
ＶＢＳの利点は、Windowsさえあればプログラムを作れてプログラムを動かせること。
それでは自作プログラムについて簡単解説。
第一のプログラムは「ファイル統合.vbs」。
このプログラムは、特定のフォルダに保存された大量のＧＰＸデータをファイル名順
（日付順）に並べて、一つのＧＰＸデータにまとめる作業を行う。
ＧＰＸデータのあるフォルダは、ポップアップ画面から選択して指定する。
ファイル名順に統合するため、FieldAccessならばファイル名の先頭の日付順を
そのまま利用して記録統合できる。
出力されるファイルは、既定値では「統合file.txt」と言う名前で、Dドライブのテスト
フォルダという所に保存されるので、各人の使用環境に合わせて変える必要がある。
（出力ファイルのフォルダが存在しないとエラー終了するので要注意！）
プログラム中のコメント「’GPXファイルを名前順に読込み～」以下で統合作業に入る。
WriteSignという変数を使い１行データ毎に統合すべきデータかどうか判断している。
緯度経度等が書かれたデータと最初のファイル先頭９行データと最後のファイルの
最後尾３行データのみ抽出するため、WriteSignが１以上（抽出）か０以下（非抽出）
に変化させる。
そして書出処理の時WriteSignを見て１以上の時だけ統合ファイルに書き出す。
なお出力ファイルの拡張子をtxtにしたのは、作業用テストフォルダ内に拡張子gpxで
存在した場合、読込と書込で同じファイルにアクセスし無限ループするのを防ぐため。
【以下は「ファイル統合.vbs」プログラムリスト】
'*********************************************
'* GPXファイルの統合 VBScriptプログラム *
'*********************************************
Option Explicit
On Error Resume Next
Dim YN ' YesNo判定
Dim objShell ' シェルアプリケーションオブジェクト
Dim objFol ' ＧＰＸファイルフォルダ名オブジェクト
Dim objFS ' ファイルシステムオブジェクト
Dim objFc ' ファイルコレクションオブジェクト
Dim objInFile, objOutFile ' ＧＰＸ入力ファイルと統合後出力ファイルオブジェクト
Dim f1, fbuf ' ファイル処理時に使用する変数
Dim fPath ' ＧＰＸファイルのフォルダのパス変数
Dim strBuffer ' １行分のデータ読み取り内容
Dim i, j, iend ' 繰り返し処理時に使用する変数
Dim fname(1000) ' ＧＰＸファイル名を格納する配列変数
Dim WriteSign ' 出力ファイルへの書き出し判定
Const WriteFile = "D:\テストフォルダ\統合file.txt"
YN = MsgBox("フォルダを選択しgpxFileを統合します" & vbCR & "実行しますか？" , vbYesNo)
If YN <> 6 Then WScript.Quit
'フォルダ参照ダイアログでフォルダを選択
Set objShell = CreateObject("Shell.Application")
Set objFol = objShell.BrowseForFolder(0,"ＧＰＸFileがあるフォルダの選択",&h11)
If objFol Is Nothing Then WScript.Quit
fPath = objFol.Items.Item.Path
Set objFol = Nothing
Set objShell = Nothing
YN = MsgBox("処理するフォルダは" & fPath & "です" & vbCR & "実行しますか？" , vbYesNo)
If YN <> 6 Then WScript.Quit
'選択フォルダ内のファイルコレクションを取得
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFc = objFS.GetFolder(fPath).Files
'選択フォルダの中からGPXファイルだけ配列変数に格納する
i = 0
For Each f1 in objFc
if Instr(f1.name,".gpx") <> 0 or Instr(f1.name,".GPX") <> 0 then
fname(i) = f1.name
i = i + 1
end if
Next
iend = i - 1
'GPXファイルを名前(日付)順に並べ替える
For i = 0 to iend-1 step 1
For j = iend to i+1 step -1
If fname(j) < fname(j-1) Then
fbuf = fname(j)
fname(j) = fname(j-1)
fname(j-1) = fbuf
End if
Next
Next
'GPXファイルを名前(日付)順に読込み、統合に必要なデータのみ書き出す
Set objOutFile = objFS.OpenTextFile(WriteFile, 2, True)
If Err.Number = 0 Then
For i = 0 to iend
Set objInFile = objFS.OpenTextFile(fPath & "\" & fname(i))
If Err.Number = 0 Then
WriteSign = 0
Do While objInFile.AtEndOfStream <> True
strBuffer = objInFile.ReadLine
'１行中に文字列[lat=]が有れば書き出す
If InStr(strBuffer, "lat=") > 0 Then
If i = iend And WriteSign < 0 Then WriteSign = 1
WriteSign = WriteSign + 1
Else
Select Case i
Case 0 '最初ファイルの先頭約9行データは書き出す
If WriteSign > -1 And WriteSign < 11 Then
WriteSign = WriteSign + 1
Else
WriteSign = -10
End If
Case iend '最後ファイルの最後尾約3行データ以外は書き出さない
If WriteSign < 1 Then WriteSign = WriteSign - 1
Case Else '中間ファイルの文字列[lat=]無しは書き出さない
WriteSign = 0
End Select
End If
If WriteSign > 0 Then objOutFile.WriteLine(strBuffer)
Loop
objInFile.Close
Else
MsgBox "入力ファイル取込失敗: " & Err.Description
End If
Next
Else
MsgBox "出力ファイル処理失敗: " & Err.Description
End If
objOutFile.Close
Set objFc = Nothing
Set objInFile = Nothing
Set objOutFile = Nothing
Set objFS = Nothing
MsgBox "処理終了"
'＊＊ 以上で「ファイル統合.vbs」プログラムの終了 ＊＊*
第二のプログラムは「ポイント間引.vbs」。
このプログラムは、統合ファイルを１行ずつ読み込み、緯度経度の差が一定以上
あればファイルに書き出し、一定以下なら無視する処理を行っている。
入力ファイルは「統合file.txt」、出力ファイルは「圧縮file.gpx」という名前で21､22行目
に記載されているが、ドライブやフォルダは各自の使用環境に合わせて変えること！
（各ファイルのフォルダが存在しないとエラー終了するので要注意！）
緯度経度差のプログラム既定値は緯度差0.006(約600m)、経度差0.007(約600m)。
プログラムの50行過ぎの「If Differlat > -0.006 And ～」箇所の数値を適宜変更し利用可。
書出し適否の判定にはCompFlagという変数を使い、１行毎のデータを調べ、先頭部と
最後部のデータはCompFlagを０，最初の緯度等データは１、緯度・経度が前データと
一定以上差があれば２に変化させ、それ以外は３以上の値をセット。CompFlagが２以下
のみ書き出す。
なお、ValuelatやDifferlat等の変数に緯度値等をセットしているが、小数点以下何桁まで
とるかは元のGPXデータに依存するのでプログラム中Valuelat = Mid(strBuffer,Findlat+5,7)
等（他８カ所）の記述を、必要に応じて７（８，６等）の値を適当に変える必要がある。
例えば地点当たりの移動の少ない歩行データなら７を８か９に変え、前述の
「If Differlat > -0.006」の0.006を例えば0.002等に変えるなど、間引き具合を調整する。
緯度経度差判定処理（50行付近）にコメント行があるが、緯度経度差が異常に大きかったり
高度差が大きい場合に異常値として除外したい場合にコメントを外して実行も考慮した。
【以下は「ポイント間引.vbs」プログラムリスト】
'*********************************************
'* GPXファイルの間引き VBScriptプログラム *
'*********************************************
Option Explicit
On Error Resume Next
Dim objFSO ' FileSystemObject
Dim objInFile ' ファイル読み込み用
Dim objOutFile ' ファイル書き込み用
Dim strBuffer ' １行分のデータ内容
Dim Findlat ' lat検索した文字位置
Dim Findlon ' lon検索した文字位置
Dim Findele ' ele検索した文字位置
Dim Valuelat ' lat(緯度)の値
Dim Valuelon ' lon(経度)の値
Dim Valueele ' ele(高度)の値
Dim Differlat ' latの値の差
Dim Differlon ' lonの値の差
Dim Differele ' eleの値の差
Dim CompFlag ' 緯度等の比較の判断
Const strInFile = "D:\テストフォルダ\統合file.txt"
Const strOutFile = "D:\テストフォルダ\圧縮file.gpx"
Const strFindlat = "lat=" ' 検索する文字列lat
Const strFindlon = "lon=" ' 検索する文字列lon
Const strFindele = "ele>" ' 検索する文字列ele
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objInFile = objFSO.OpenTextFile(strInFile)
Set objOutFile = objFSO.OpenTextFile(strOutFile, 2, True)
If Err.Number = 0 Then
CompFlag = 0
Do While objInFile.AtEndOfStream <> True
CompFlag = CompFlag + 1
strBuffer = objInFile.ReadLine
Findlat = InStr(strBuffer, strFindlat)
Findlon = InStr(strBuffer, strFindlon)
Findele = InStr(strBuffer, strFindele)
If Findlat = 0 Then
CompFlag = 0
Else
If CompFlag = 1 Then
Valuelat = Mid(strBuffer,Findlat+5,7)
Valuelon = Mid(strBuffer,Findlon+5,8)
Valueele = Mid(strBuffer,Findele+4,4)
End If
If CompFlag > 1 Then
CompFlag = 1
Differlat = Valuelat - Mid(strBuffer,Findlat+5,7)
Differlon = Valuelon - Mid(strBuffer,Findlon+5,8)
Differele = Valueele - Mid(strBuffer,Findele+4,4)
If Differlat > -0.006 And Differlat < 0.006 And Differlon > -0.007 And Differlon < 0.007 Then CompFlag = 3
' If Differlat < -0.1999 And Differlat > 0.1999 Then CompFlag = 7
' If Differlon > -0.1999 And Differlon > 0.1999 Then CompFlag = 7
' If Differele < -50 And Differele > 50 Then CompFlag = 5
End If
End If
If CompFlag < 3 Then objOutFile.WriteLine(strBuffer)
If CompFlag = 1 Then
Valuelat = Mid(strBuffer,Findlat+5,7)
Valuelon = Mid(strBuffer,Findlon+5,8)
Valueele = Mid(strBuffer,Findele+4,4)
End If
Loop
objInFile.Close
objOutFile.Close
Else
WScript.Echo "ファイルオープンエラー: " & Err.Description
End If
Set objInFile = Nothing
Set objOutFile = Nothing
Set objFSO = Nothing
MsgBox "処理終了"
'＊＊ 以上で「ポイント間引.vbs」プログラムの終了 ＊＊*
【注意】 プログラム中、入出力ファイルの記述でＤドライブのルート「￥」表示が
半角表示では「\」表示になっています。利用の際はご注意願います。
※ 著作権は「たけなみ」に帰属します。
※ 利用や再配布に一切制限はありません。
※ 作者はプログラム利用に伴う全ての損害等に一切責任を負いません。