LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@Q11Q

VBA VBS Mappleの法務局地図ビューアから指定した筆のGeoJsonデータを取得して国土地理院地図に反映する

Posted at

まず登録する

無料なので、メールアドレスとパスワードを登録する。

ここから
image.png

これをクリックしてアカウントを作成するかログインする

目標とする土地の緯度、経度をGoole Mapから取得する

今回は青森県青森市の駐車場にしてみる。ここにしたのは特に家屋がないからでそれ以外の意図はありません。
所在地　青森市中央町12番8
緯度、経度 40.8144954/140.7523655
国内だけなので、北緯、東経はデフォ。

image.png

GeoJsonを
クリックするとgeojsonファイルがダウンロードされる。
この時、筆ID　をメモする H000000018

筆ID

これは各ファイルごとに決まっているらしい。
このため、１つのファイルから地番を抜き出すときは重複がないので使える。

ファイルの中身

ファイル形式

UTF-8 テキスト 改行コードLF
解いても改行は入らない

データ構成

データベースは昔、蛇みたいに頭、体、しっぽと分けて説明されていた。
今回はこれに倣って記述する。
頭というのはデータの種類や文字コードみたいな設定が入る。
体というのはデータそのもので、頭で説明した順番で項目が並んでいる。
しっぽはデータが終わったことを知らせる、という機能を持つ。

Head

{"type":"FeatureCollection","features":[
どうもFeatureのコレクションという集合でFeatures以下が各Feautureオブジェクトということらしい。

Tail

]}
この辺はタグで閉じるというxmlやhtmlでおなじみの終わり方となっている。

1筆ごとのデータ

緯度、経度のデータの次に地番等のデータがあるという構成。
緯度、経度は小数点以下9位まで持っている
筆IDは各ファイルごとにつけられているらしい。

{"type":"Feature","geometry":
　{"type":"MultiPolygon","coordinates":
   [
 　 [
  　 [
      [140.752148452,40.814466413],
      [140.752348133,40.814529549],
      [140.752427866,40.814389096],
      [140.752411906,40.814363958],
      [140.7521845,40.814329468],
      [140.752148452,40.814466413]
  　 ]
 　 ]
   ]
   },
    "properties":{"ファイル名":"02201-4200-223.xml",
     "筆ID":"H000000018",
     "version":"ver1.0",
     "座標系":"公共座標10系",
     "測地系判別":"変換",
     "地図名":"10047_hosei_20121106101302",
     "地図番号":"N4  54-4",
     "縮尺分母":"500",
     "市区町村コード":"02201",
     "市区町村名":"青森市",
     "大字コード":"117",
     "丁目コード":"004",
     "小字コード":"0000",
     "予備コード":"00",
     "大字名":"中央",
     "丁目名":"４丁目",
     "地番":"12-8",
     "精度区分":"甲二",
     "座標値種別":"図上測量",
     "代表点緯度":40.814427755,
     "代表点経度":140.752282274,
     "面積":"約345.3平方メートル"
　}
},

複数の場合は,で続ける。一筆だけならつかない。
実際は改行コードがないので、Head Body Tailと１行で全部記述する形式になっている。

正規表現

ということで

{"type":"Feature","geometry":
　{"type":"MultiPolygon","coordinates":

正規表現で１筆ごとの塊を抜き出すため、ここで正規表現を使う。
次に筆IDで判定して、抜き出したものを再度GeoJsonとする。

国土地理院の地図にgeojsonを読み込ませる

https://maps.gsi.go.jp/#18/40.814430/140.752288/&base=std&ls=std&disp=1&vs=c1g1j0h0k0l0u0t0z0r0s0m0f1
ツール　図形 geojsonファイルを作図・ファイルの囲みにドラッグする

image.png

そうするとデータが反映された。
なお、作図結果はiframeでは反映されないが、画像では反映される。

<iframe frameborder="0" scrolling="no" marginheight="0" marginwidth="0" width="100" height="100" src="https://maps.gsi.go.jp/?hc=hic#18/40.814408/140.752265/&base=std&ls=std&disp=1&vs=c1g1j0h0k0l0u0t0z0r0s0m0f1"></iframe>

Qiitaではインラインフレームは表示されるか？

空白ならQiitaではインラインフレームは反映されないようだ。
そこで画像で取得してみる。
縮尺も著作権も表示されて便利だ。
img20240426063942679.png

この技術は何に使う

国土地理院地図に一筆の土地を描画する方法としては

  1. 測量図からGeoJsonファイルを作る方法
  2. 航空写真を重ねて手で点を打つ
という方法しかありません。 しかし国土調査で作成された14条地図は精度が高いです。 宅地の面積として必要な100分の1まではないので、測量図としては通用しないが、それでも地形を正確に描ける。 手で描く方法は特に道路との境界があいまいとなる。 そこで測量図に次ぐ方法として、字図のデータがあればそれを使うことで道路との境界も明確になり、正確な地形が描ける。

最寄り駅と住居表示はYahoo!地図

緯度経度を取得すると、Yahoo!地図に入力することで住所が取得できる。
もちろん、Google Mapでも取得できるが、Yahoo！地図はゼンリンベースなので、住所の枝番表示が表示される。
2024年５月に変更になるのでこのまま使えるかは不明だが、以下のようなURLなので緯度、経度を入れる。
https://map.yahoo.co.jp/place?lat=40.81443&lon=140.75220&zoom=18&maptype=basic
しかし、小数点以下6位まででデータが消える。このためマーカー位置がいま一つきまらない。手動で若干調整する場合もある。
独自の機能は最寄駅からの距離を表示する点だろうか。最寄り駅の基準は不明だが、全く知らない土地で目安をつけるには便利だと思う。

短縮URL
https://yahoo.jp/m78haq

<script type="text/javascript" src="https://map.yahoo.co.jp/embedmap/V3/?lon=140.7522&lat=40.81443&zoom=18&cond=action:place;maptype:basic;lon:140.75220;lat:40.81443&width=200&height=200"></script>

image.png

image.png

またスマホ情報を利用した人の混雑レーダー、雨雲レーダー、をレイヤできる。
地図自体も交通状況等がある。おそらくカーナビにもデータを使っているのだろう。

コード

地図の話は地味なのでここまで引っ張ったが、最後はCode
::: note warn
このコードだとデータの最後にある筆は取得できないので、メモ帳で開き、手動で取得することになる。
:::
::: note
厳密にいうとファイル名も書き換える必要があるはずだが、それを書き換えなくても読み込める。国土地理院では無視しているのかもしれない。
:::

ダウンロードしたファイルが次の場所にあると仮定している
普通はダウンロードと表示されるフォルダである。
コードではenviron関数を使って一般化している。

"C:\Users\hoge\Downloads\02201-4200-223.geojson"

参照設定

Microsoft ActiveX Data Object Version 6.1
Microsoft Scripting Runtime
Microsoft VBScript Regular Expression 5.5
ダウンロードしたgeojsonファイルを読み込み、
Dドライブに保存する
複数の筆IDを選ぶには
以下のようにIf をOrでつなぐ

   If buf2 Like "*H000000018*" Or _
     buf2 Like "*H000000000*" Or _
     buf2 Like "*H000000000*" Or _
     buf2 Like "*H000000000*" Or _
     buf2 Like "*H00000000*" _
   Then
     nBuf = nBuf & buf2
   End If

正規表現はエスケープが必要になる。実際は¥で表示されるが、Qiitaでは\と表示される。

Sub test()
Dim sr As New ADODB.Stream
Dim fso As New Scripting.FileSystemObject
Dim buf As String, buf2 As String
Dim Reg As New RegExp, MC As MatchCollection, M As Match, iM As Long
Dim nBuf As String
With Reg
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "\{""type"":""Feature"",""geometry"""
End With
iRow = 1

With sr
.LineSeparator = adLF
.Charset = "utf-8"
.Type = adTypeText
.Mode = adModeReadWrite
.Open
.LoadFromFile Environ("userprofile") & "\Downloads\02201-4200-223.geojson"
buf = .ReadText(adReadAll)
Set MC = Reg.Execute(buf)
’ Debug.Print MC.Count
nBuf = ""
nBuf = "{""type"":""FeatureCollection"","
nBuf = nBuf & """features"":["
For iM = 0 To MC.Count - 2 
Set M = MC(iM)
buf2 = Mid(buf, M.FirstIndex + 1, MC(iM + 1).FirstIndex - M.FirstIndex)
If buf2 Like "*H000000018*" Then
   nBuf = nBuf & buf2
End If
  Next
.Close
End With
nBuf = Left(nBuf, Len(nBuf) - 1) & "]}"
sr.Open
sr.WriteText nBuf
If fso.FileExists("D:\new.geojson") Then fso.DeleteFile "D:\new.geojson"
sr.SaveToFile "D:\new.geojson", adSaveCreateNotExist
End Sub

VBScript

Windows 11が最新版の場合、NotepadはANSIファイルを新規作成できるようになりました。
ファイル名の設定や筆IDを毎回設定する必要がありますが、geojsonファイルは11MBになる場合もあるので、有効だと思います。

test.vbs
Dim sr: Set sr = CreateObject("ADODB.Stream")
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim buf, buf2
Dim Reg: Set Reg = CreateObject("VBScript.RegExp")
Dim MC, M, iM
Dim nBu
Dim oShell: Set oShell = CreateObject("WSCript.Shell")
With Reg
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "\{""type"":""Feature"",""geometry"""
End With
With sr
.LineSeparator = 10
.Charset = "utf-8"
.Type = 2
.Mode = 3
.Open
.LoadFromFile oShell.expandenvironmentstrings("%userprofile%") & "\Downloads\02201-4200-223.geojson"
buf = .ReadText(-1)
Set MC = Reg.Execute(buf)
nBuf = ""
nBuf = "{""type"":""FeatureCollection"","
nBuf = nBuf & """features"":["
For iM = 0 To MC.Count - 2
Set M = MC(iM)
buf2 = Mid(buf, M.FirstIndex + 1, MC(iM + 1).FirstIndex - M.FirstIndex)
If buf2 Like "*H000000018*" Then
   nBuf = nBuf & buf2
End If
  Next
.Close
End With
nBuf = Left(nBuf, Len(nBuf) - 1) & "]}"
sr.Open
sr.WriteText nBuf
If fso.FileExists("D:\new.geojson") Then fso.DeleteFile "D:\new.geojson"
sr.SaveToFile "D:\new.geojson", adSaveCreateNotExist
sr.Close
Set sr = Nothing
Set fso = Nothing
Set oShell = Nothing
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?