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

## 地図タイルダウンローダー
http://notmushroom.stars.ne.jp
https://github.com/notmushroom/WebTileMapDownloader
上のリンクからダウンロードして使用してください。
地理院タイル等をダウンロードできます。
動作環境：Win10 64bit、.NetFramework4.8
![画像1.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/394814/a89bd6b2-0b5d-e2ec-7803-30f34ce3b9c1.png)


# 地図画像の取得
　さて、<a href="https://qiita.com//notmushroomnot/items/0a3cc75bb05584abef20">前の記事</a>に書いた通り地理院タイルの使用許諾は得た。じゃあ、画像をもらえばいいじゃんと思うがそうはいかない。
　地理院は現在、対外向けに地図画像の一括配布を行っていない。<font color="Gainsboro">協定を結べばHDDごと貸与されるらしいが根拠はない</font>
　ということで、１枚ずつ取得して行くわけだが、下の画像を見て欲しい。
![tileNum.png](https://qiita-image-store.s3.amazonaws.com/0/394814/11dbabc4-3938-65eb-50dc-3e0bb4c3bd18.png)
　一回のズームで地図の枚数は4倍になる。
　今回使用する地理院地図の標準地図はLv2~Lv18まであり、lv17の途中までダウンロードしたが全て合わせると100GBを越えており１枚5KB程度としても単純純計算で、2,000万枚あることになる。
　人力でのダウンロードは無理なので、ExcelのVBAを使ってダウンロードしていく。
　VBAを使う理由は単純に普段から使っていて使いなれているからだ。

## ExcelVBAによる自動ダウンロード
　ダウンロードする前に地図の東西南北端の座標を調べる必要がある。
　座標は一般的な地理院地図でも見れるが、<a href="https://maps.gsi.go.jp/development/tileCoordCheck.html#5/35.362/138.731">タイル座標確認ページ</a>の方が使いやすいように思う。
　座標は、「ズームレベル/X座標/Y座標」の順に記述されている。
![_20190410_184559.JPG](https://qiita-image-store.s3.amazonaws.com/0/394814/79ae4349-ec71-8d53-eb36-40c721d5a44e.jpeg)

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

```vb

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以降は、まとめてダウンロードすると非常に時間がかかるのでエリアを区切るため。
　最終的には以下よりも細かく区切り、赤枠のそれぞれ東西南北端の座標を調べる。
　全体の東西南北端を調べて一括でやるのもいいが、時間がかかるのでおすすめしない。
![201904110.JPG](https://qiita-image-store.s3.amazonaws.com/0/394814/be3a95b5-f50c-a4ab-a56e-2fcb68a02bc6.jpeg)

東西南北端の地図タイル座標は次の通り
|**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 |

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

```vb
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程度しかアップできないことが判明。試しにファイルサーバーに置いてみたところ、ファイルサーバーにアクセスできる端末からは表示された。
　という訳で、ファイルサーバーに画像を置く方法で今後は説明する。
　実際の読み込みなどは<a href="https://qiita.com/notmushroomnot/items/67dd8f27d86880c51d1e">次の記事</a>で。