イントラネットで地図サービスを使いたい２-地図タイルダウンロード-

地図タイルダウンローダー

http://buraritabi.starfree.jp
https://github.com/notmushroom/WebTileMapDownloader
上のリンクからダウンロードして使用してください。
地理院タイル等をダウンロードできます。
動作環境：Win10 64bit、.NetFramework4.8

地図画像の取得

　さて、前の記事に書いた通り地理院タイルの使用許諾は得た。じゃあ、画像をもらえばいいじゃんと思うがそうはいかない。
　地理院は現在、対外向けに地図画像の一括配布を行っていない。協定を結べばHDDごと貸与されるらしいが根拠はない
　ということで、１枚ずつ取得して行くわけだが、下の画像を見て欲しい。

　一回のズームで地図の枚数は4倍になる。
　今回使用する地理院地図の標準地図はLv2~Lv18まであり、lv17の途中までダウンロードしたが全て合わせると100GBを越えており１枚5KB程度としても単純純計算で、2,000万枚あることになる。
　人力でのダウンロードは無理なので、ExcelのVBAを使ってダウンロードしていく。
　VBAを使う理由は単純に普段から使っていて使いなれているからだ。

ExcelVBAによる自動ダウンロード

　ダウンロードする前に地図の東西南北端の座標を調べる必要がある。
　座標は一般的な地理院地図でも見れるが、タイル座標確認ページの方が使いやすいように思う。
　座標は、「ズームレベル/X座標/Y座標」の順に記述されている。

　調べたら、画像をダウンロードするためのフォルダを作成する。
　基本構造は、Lv/X/Y.pngなので
　Lv(フォルダ)\X(フォルダ)を作成し、Xフォルダの中にY(png画像)をダウンロードする。
　まずは、Lvフォルダを作成
　VBAは以下の通り。

Option Explicit
Sub CreateFolder()
Dim FolderPath
Dim MapLv
Dim Fso As Object
'フォルダを作成するフォルダを指定
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    FolderPath = .SelectedItems(1)
End With

'指定フォルダにStdフォルダを作成
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CreateFolder FolderPath & "¥Std"
Set FSO = Nothing

'StdにLvフォルダを作成
For MapLv = 2 To 18
     If Dir(FolderPath & "¥" & MapLv, vbDirectory) = "" Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.CreateFolder FolderPath & "¥Std¥" & MapLv
        Set FSO = Nothing
     End If
Next

End Sub

　作成したLvフォルダにX フォルダを作成
　Xフォルダの中へ地理院タイルをダウンロードしていく。
　ここでは、Lv、X、Yを指定してダウンロードするが、これは、Lv10以降は、まとめてダウンロードすると非常に時間がかかるのでエリアを区切るため。
　最終的には以下よりも細かく区切り、赤枠のそれぞれ東西南北端の座標を調べる。
　全体の東西南北端を調べて一括でやるのもいいが、時間がかかるのでおすすめしない。

東西南北端の地図タイル座標は次の通り

Map	ズームレベル	北端	西端	東端	南端
標準地図	9	182	430	475	226
標準地図	10	365	861	950	452
標準地図	11	731	1723	1900	905
標準地図	12	1464	3445	3803	1815
標準地図	13	2928	6890	7606	3631
標準地図	14	5857	13779	15212	7262
標準地図	15	11702	27556	30403	14502
標準地図	16	23403	55113	60807	29003
標準地図	17	46805	110227	121615	58005
標準地図	18	93672	220546	243230	115944

　画像ダウンロードのVBAは以下の通り。

Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
   (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal IpfnCB As Long) As Long

Sub Download_File()
Dim MapLv
Dim MapXw,MapXe
Dim MapYna,MapYnb,MapYs
Dim IngRes As Long
Dim MapURL As String
Dim FolderPath As String,FilePath As String,FPath As String
Dim FSO As Object

MapLv = 2'ズームレベル
MapXw = 0'最西端のX座標
MapXe = 3'最東端のx座標
MapYna = 0'最北端のy座標
MapYnb = MapYna
MapYs = 3'最南端のy座標
MapYs = MapYs + 1

'Stdフォルダパスを取得する
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    FolderPath = .SelectedItems(1)
End With

Do
    FPath  = FolderPath & "¥" & MapLv & "¥" & MapXw
'Xフォルダの作成
    If  Dir(FPath, vbDirectory) = "" then 
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.CreateFolder FPath
        Set FSO = Nothing
   End if 

'ダウンロード
    If Dir(FPath & "¥" & MapYna & "¥" & ".png") = "" Then
        MapUrl = "http://cyberjapandata.gsi.go.jp/xyz/std/" & MapLv & "/" & MapXw & "/" & MapYna & ".png"
        FilePath = FPath & "¥" & MapYna & ".png"
        IngRes = URLDownloadToFile(0, MapUrl, FilePath, 0, 0)
    End If

    MapYna = MapYna + 1

    If MapXw = MapXe And MapYna = MapYs Then
        Exit Do
    End If

    If MapYna = MapYs Then
        MapXw = MapXw + 1
        MapYna = MapYnb
    End If
Loop
End Sub

　Lv17までダウンロードしたが、回線やPCスペックの問題もあり、ここまで、約３ヵ月かかった。

画像の設置場所について

　ダウンロードした地理院タイルはWebサーバに置くことになるが、いざ、アップロードしてみると100Mb程度しかアップできないことが判明。試しにファイルサーバーに置いてみたところ、ファイルサーバーにアクセスできる端末からは表示された。
　という訳で、ファイルサーバーに画像を置く方法で今後は説明する。
　実際の読み込みなどは次の記事で。