等高線地図作成VBAモジュール変更

自作のGPS地図を半年以上使っているが、少し修正することにした。

修正ヶ所は、①500、100、20m毎各等高線の出現タイミング、と②20m等高線の標高表示を画面が煩わしくなるので廃止の2点。

ズームイン時:
修正前
--------------------------------------
1st Step: 500m等高線のみ表示
2nd Step: 100m,20m等高線を同時に表示開始

修正後
--------------------------------------
1st Step: 500m等高線のみ表示
2nd Step: 100m等高線表示開始
3rd Step: 20m等高線表示開始

詳しくは、本家サイトを、どうぞ(^^)v
スポンサーサイト
THEME:アウトドア | GENRE:趣味・実用 |

MS-EXCEL VBAで経緯度取得

GPS用地図を作っていて、下図のようにエクセルで緯度経度を取得する自作関数(VBA)が作れればいいなと思った。
↓A1セルに地名または住所を入力すると、B1セルに経度、C1に緯度が表示される。


ネットを調べたら参考になりそうなのがありました。
http://www.simple-sys.com/blog/2008/04/06/301/
http://www.happy2-island.com/vbs/cafe02/capter00701.shtml
いわゆる”スクレイピング”という技術で、「YAHOO!MAP」にアクセスして経緯度情報だけ「削り取る」動作をVBAでコーディングして、自作関数としてセルへ埋め込むという仕掛けです。

普通にWEB上で「札幌駅」と入力して「検索ボタン」を押し、複数の候補から「札幌駅」をクリックすると地図が表示されますが、その時のURLに経緯度情報が含まれています。これを削り取ってくるのです。下のアンダーライン部がそうです。
http://map.yahoo.co.jp/pl?p=%BB%A5%CB%DA%B1%D8&lat=43.065638&lon=141.35427733&type=&ei=euc-jp&v=2&sc=3&lnm=%BB%A5%CB%DA%B1%D8&idx=25

ただし、「YAHOO!MAP」は測地系がTOKYOなのでWGS84への変換関数も組み込みました。変換式は下記サイトの簡便式「三角関数を使わない式」を採用。今回はこれで十分でした。
http://homepage3.nifty.com/Nowral/02_DATUM/02_DATUM.html#HowTo

その結果、私が少し手を加え完成させたEXCEL自作関数がこれ↓


Function 関数地名to経度変換(p As String)
'「yahoo!map」から経度緯度情報(datum=tokyo)を取得する自作関数
'セルへ埋め込む自作関数として機能する。
'戻り値はTOKYOからWSG84へ変換してあります。
'p: 地点名(漢字) ln: 経度 la:緯度

Dim Address, result_str, Title, chk As String
Dim ln, la As String
Dim n1, n2, n3 As Integer

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True

Address = p
objIE.navigate "http://map.yahoo.co.jp/"

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

Title = objIE.LocationName

objIE.document.forms(1).Item("search_ms_p").Value = Address
objIE.document.forms(1).Item("search_ms_submit").Click

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

chk = objIE.LocationName
Do While chk = Title
chk = objIE.LocationName
DoEvents
Loop

Title = objIE.LocationName
Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

result_str = objIE.document.links(20).href
n1 = Application.WorksheetFunction.Find("&lat=", result_str, 1)
n2 = Application.WorksheetFunction.Find("&lon=", result_str, 1)
n3 = Application.WorksheetFunction.Find("&type", result_str, 1)

ln = Mid(result_str, n2 + 5, n3 - n2 - 5)
la = Mid(result_str, n1 + 5, n2 - n1 - 5)

'WGS84へ数値変換
関数地名to経度変換 = TKY2WGS経度(ln, la)

objIE.Quit
Set objIE = Nothing
End Function


Function 関数地名to緯度変換(p As String)
'p: 地点名(漢字) ln: 経度 la:緯度

Dim Address, result_str, Title, chk As String
Dim ln, la As String
Dim n1, n2, n3 As Integer

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True

Address = p
objIE.navigate "http://map.yahoo.co.jp/"

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

Title = objIE.LocationName
objIE.document.forms(1).Item("search_ms_p").Value = Address
objIE.document.forms(1).Item("search_ms_submit").Click

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

chk = objIE.LocationName
Do While chk = Title
chk = objIE.LocationName
DoEvents
Loop

Title = objIE.LocationName
Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

result_str = objIE.document.links(20).href
n1 = Application.WorksheetFunction.Find("&lat=", result_str, 1)
n2 = Application.WorksheetFunction.Find("&lon=", result_str, 1)
n3 = Application.WorksheetFunction.Find("&type", result_str, 1)

ln = Mid(result_str, n2 + 5, n3 - n2 - 5)
la = Mid(result_str, n1 + 5, n2 - n1 - 5)

'WGS84へ数値変換
関数地名to緯度変換 = TKY2WGS緯度(ln, la)

objIE.Quit
Set objIE = Nothing
End Function

Function TKY2WGS緯度(東経 As Variant, 北緯 As Variant)
'測地系TOKYOの数値をWGS84系へ変換する(簡易)
'東経:入力経度、北緯:入力緯度、lng:変換後経度、lat:変換後緯度

lng = 東経 - 北緯 * 0.000046038 - 東経 * 0.000083043 + 0.01004
lat = 北緯 - 北緯 * 0.00010695 + 東経 * 0.000017464 + 0.0046017
TKY2WGS緯度 = Format(lat, "#00.0000000")
End Function

Function TKY2WGS経度(東経 As Variant, 北緯 As Variant)
'測地系TOKYOの数値をWGS84系へ変換する(簡易)
'東経:入力経度、北緯:入力緯度、lng:変換後経度、lat:変換後緯度

lng = 東経 - 北緯 * 0.000046038 - 東経 * 0.000083043 + 0.01004
lat = 北緯 - 北緯 * 0.00010695 + 東経 * 0.000017464 + 0.0046017
TKY2WGS経度 = Format(lng, "#00.0000000")
End Function


さて、この自作関数(ユーザー関数)の使い方ですが、汎用関数と同じようにメニューの挿入(I)-関数(F)-関数の貼り付け、を開き関数の分類で一番下の「ユーザー定義」を選択し、右の窓から経度なら「関数地名to経度変換」を、緯度なら「関数地名to緯度変換」をクリックします。

scraping02.jpg

次にパラメータとして「地名」セルを指定します。
scraping03.jpg

このページ冒頭の図のように経度と緯度が出れば完成です。

ただ実際に使用すると、次のような問題が発生しあまり実用的ではなかった。残念!
1.「計算方法」を手動にしておいても「ウインドウ」がパカパカと何回も(通常3回)開き、わずらわしい。自動計算を完全に抑制できないのです(泣)。
2.複数候補があると選択画面でフリーズして自動で閉じない時がある。
3.「札幌駅」などのような固有地名なら精度は高いが、「札幌市北7条」のような住所ではあまり当てにならない。「カシミール3D」や「ウォッチ地図」から引いたほうが早いかも。

多くの地名を調べたいときは自作関数ではなく、こちらのマクロで一括処理した方が良い。
WGS84へ変換して出力するので、上述の測地系変換関数が必要です。
なんか、こちらのほうがストレスが少なくて使い勝手がよさそう(^^)v


Sub 地名to経緯度変換()
'yahoo!mapから経度緯度情報(datum=tokyo)を取得し
'WGS84へ変換して出力するVBA

Dim Address, result_str, Title, chk As String
Dim n1, n2, n3 As Integer
Dim la, ln As String

Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True
Range(Cells(1, 2), Cells(Range("A65536").End(xlUp).Row, 3)).Cells.Value = ""

For i = 1 To Range("A65536").End(xlUp).Row Step 1
Address = Cells(i, 1).Value
objIE.navigate "http://map.yahoo.co.jp/"

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

Title = objIE.LocationName

objIE.document.forms(1).Item("search_ms_p").Value = Address
objIE.document.forms(1).Item("search_ms_submit").Click

Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

chk = objIE.LocationName
Do While chk = Title
chk = objIE.LocationName
DoEvents
Loop

Title = objIE.LocationName
Do While objIE.Busy = True
DoEvents
Loop

Do While objIE.readyState <> 4
DoEvents
Loop

result_str = objIE.document.links(20).href
n1 = Application.WorksheetFunction.Find("&lat=", result_str, 1)
n2 = Application.WorksheetFunction.Find("&lon=", result_str, 1)
n3 = Application.WorksheetFunction.Find("&type", result_str, 1)

la = Mid(result_str, n1 + 5, n2 - n1 - 5)
ln = Mid(result_str, n2 + 5, n3 - n2 - 5)

'WGS84へ数値変換
Cells(i, 2).Value = TKY2WGS緯度(ln, la)
Cells(i, 3).Value = TKY2WGS経度(ln, la)

Next i
objIE.Quit
Set objIE = Nothing
End Sub
THEME:アウトドア | GENRE:趣味・実用 |

基盤地図情報で自作地図事始め(5)

国土地理院のビューワー・コンバート・ソフトとGPSMapEditを使って作成した等高線は、報告した通り実用的でない。そこでアプローチを変えて、XMLファイルから直接PFM(ポーリッシュ・フォーマット・ファイル、[*.mp])を生成するVBAスクリプトを作成した。

仕様は、
1.等高線間隔は20mとする。
2.標高500m未満の等高線は作成しない。ただし、スクリプトで変更は可能。
3.等高線を500m、100m、20m毎に色や太さを変えて視認性をよくする。
4.標高値を表示する。
5.描画ズーム・レベル200mまでは500m毎等高線しか表示しない(但し、詳細レベル[普通]の場合)。

手順
1.基盤地図情報をダウンロードし、XMLへ展開(解凍)する。
2.XMLを自作VBA(MSエクセルへ設定)でPFM(*.mp)へ変換する。
3.GPSMapEditでGPSマップ(*.img)へ変換する。

↓結果はこんな感じです。
Zoom2.jpg  等高線のGPS表示
↑詳細レベル:普通 (normal)  ↑詳細レベル:普通 (normal)

MAP60CSxは、「表示詳細」を変えられる。私は、普段詳細レベルを「最精細(most)」に設定している。

↓詳細レベルが「最精細(most)」では、ズームレベル500mから「20m毎等高線」を表示する。
zoom500  等高線のGPS表示2
↑詳細レベル: 最精細

前回作成したマップと比較すれば、その差は歴然です。

↓前回作成のマップ(注:上の地図とは場所が違います。)
ルート表示    GPS画像雲取山付近

VBAは、本館へ掲載しました。MSエクセルのシートにボタンを配置して、マクロとして登録すれば、簡単に動作させることができます。

以上、ガーミンMAP60CSxでの検証結果でした。検証していませんが、GARMINの他のGPS eTrexやNuviにも搭載できるはずです。

これらの検証結果を発展させ、実用的な等高線地図が作れるようになりましたので、自分のHPへ掲載しました。興味のある方は、のぞいて見て下さい。同じく基盤地図情報の「道路縁」データから作成したマップを被せると、カーナビとしてはダメですが、登山地図としては最新国土地理院データが使えるので、最高です。
THEME:アウトドア | GENRE:趣味・実用 |

基盤地図情報で自作地図事始め(4)

sendmap20を起動して「Add maps」ボタンでGPSへ転送したい地図(*.img)を追加します。
今回は、昔「空間データ基盤」データで作成した地図(道路、川、鉄道)と、今回作成した等高線地図の2つを選択。

USB接続を確認して、「Upload maps to GPS」ボタンをクリックするとアップロードが開始される。わかりやすくするためウェイポイント(雲取山)もカシミールから転送しておく。
自作マップアップロード

↓雲取山付近(標高が表示されない) ↓秩父湖(道路と川が透過で表示されている)
GPS画像雲取山付近     画像秩父湖

↓登山道の無い地図は味気ないので、カシミールで作ったルートをトラック・データとしてアップロードしてみる。これなら実用になるかな。もし、基盤地図情報で作成した道路地図を重ねたら、どうなるのだろう?
ルート表示
以上で今回のトライアル・シリーズは終了。

【問題点】
1.標高が表示されない。
2.全て同じ線種で標高が推定できない。前の「空間データ基盤」情報なら、1000m毎に太線で表示された。
3.10mメッシュは重すぎ・・・!表示(画面更新)が遅い。
↓描画ズーム・レベル2kmでは、茶色の雲に画面が覆い尽くされた。実態は、密な等高線地図だ。ズーム・レベル設定を変えるか、20mメッシュに間引きしたほうが良さそうだ。
雲?

これらの原因は、データ変換の過程でLabel情報が欠落してしまったことが原因だ。
解決にはかなりの力技を使うか、アプローチの変更が必要になりそうだ。

・・・・なんか気が重くなってきた・・・。

続く・・・

結果的に、この方法で等高線地図を作るのは断念した。XMLデータからPFMデータへ直接変換する方法で、実用的な等高線地図が作れるようになりましたので、自分のHPへ掲載しました。興味のある方は、どうぞのぞいて見て下さい。
参考だが、GARMIN Nuvi(ヌビ)にもこの自作地図が搭載できるようだ(ヒゲMacさんのブログから)。
THEME:アウトドア | GENRE:趣味・実用 |

基盤地図情報で自作地図事始め(3)

GPSMapEdit上でマップ・プロパティを設定します。

メニュー「File」-「Map Properties」でプロパティ画面を開く。

1. 「Header」タブ
「ID」に8桁の数字を指定。(MapSource互換地図にするなら8桁が条件)
注意! IDが同じ地図(マップ)はGPSでは片方が表示されません。
「Name」は英語版GPS用なので英数字で入力。
「Code page」は英語版GPS用なら「0(7-bit ASCII)」、日本語版なら「932・・・Shift-JIS」。
「Coding schema」は英語版GPS用なら「American(7-bit)」か「European {single-byte}」。日本語版なら「Far East {Multi-byte}」。
その他は下図の通り。
Myproparties-header.jpg


2. 「Levels」タブ
とりあえずこのままにしておく。このデータなら、変えても無意味だから・・・・
levels


3. 「cGPSmapper」タブ
「TRE size」の意味を良く理解していないが、マニュアルにしたがって「1000」以上にする。大きくするとGPSで表示が遅くなると説明がある。
「RGN limit」はマニュアルに従い「1024」とする。
「TRE margin」も意味がわかっていないが、デフォルト(既定)のまま「0.000」とする。
「Map is transparent(透過の意味)」は、基本的に「S-Transparent map with ・・・」にする。

その他は、下図の通り無意味なチェックは全て外す。
Myproparties-cgpsmapper.jpg



4. その他のタブ
「Bound」「Statistics」「Source」「Extras」のその他タブは、デフォルトのまま放置。

以上で、プロパティ設定は完了。

次は、いよいよ「*.img」ファイルへの変換だが、その前に必ずメニューの「File」-「Save Map As ... 」でポーリッシュ・フォーマット「*.mp」へ保存する。保存しないと怒られる。これ仕様・・・!「Cntr.mp」で保存した。
save map as

いよいよ、この「Cntr.mp」を「img」ファイルへ変換します。メニューの「File」-「Export」-「Garmin IMG/cgpsmapper.exe」をクリックする。
gpsmapedit-export.jpg

下のような出力画面が開くので、「cGPSmapper.exe」へのパスを指定して、「Run」ボタンをクリックする。
cgpsmapper指定

処理は元のPFM(*.img)ファイルのサイズが大きくなると、等比級数的に処理に時間がかかります。
ファイルが小さいとあっという間に終わるんですが、大きくなるとどんどん処理時間が長くなります。

「*.img is ready to use.」とメッセージが流れたら変換完了です。

↓処理完了
完了
GARMIN GPS用地図(*.img)が出来ました。あとはこれをGPSへ転送するだけ。

以下次号
THEME:アウトドア | GENRE:趣味・実用 |
プロフィール

アベル父さん

Author:アベル父さん
団塊世代、男

最近のトラックバック
月別アーカイブ
FC2カウンター