[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『任意のｎ点を四角形になるように並べ替えたい』（Roku）
WinXPPro・Excel2003を使用しています。 下記のように任意の4点（緯度経度）を指定したときに四角形（□型・×形はNG）になる ように並べ替えたいのですが、どのようにすれば出来るでしょうか？ 要は順に点を結んだとき、線が交差しなければOKです。
緯度 経度 度 分 秒 南北 度 分 秒 東西 34 41 43.0798 N 135 9 4.0743 E 34 41 43.0798 N 135 10 4.0743 E 34 42 57.0012 N 135 9 7.2569 E 34 42 43.0798 N 135 10 4.0743 E
ちなみにGoogleEarthに取り込むためのkmlファイルの作成に使用します。 例では4点ですが、実際にはn点です。
VBAもOKです。どうかよろしくお願いします。
参考になりそうなサイトがありました。
http://www5d.biglobe.ne.jp/~tomoya03/shtml/algorithm/Heiro.htm
ここを研究してみては？ 私は、未検証です。
VBAではなく、VBなのでDLしても作動しないもしれませんが、 コードを分析したり、サイトに記述されている説明で考え方の指針にはなると 思います。
ichinose
質問者では在りませんが
ichinoseさん有難うございます
私の方は単純に興味からだけですが？ 昨日から、どの様に並べ代えたらいいのか悩んでいました 直線の傾き順に並べれば善いと言う事で、（傾きの計算が腑に落ちない気がしますが？） 私のTestコードの方は一応動く様です
此れで胸のつかえが取れて、仕事に集中出来そうです
(Bun = Hirofumi)
遅くなり申し訳ありません。
ご回答ありがとうございます。
リンク先サイト、とても参考になりました。 基準点を最南点におき、そこからの傾きを求めて、 その数値をもとにソートすることができました！ 久しぶりに三角関数を扱ったりして学生時代に戻った ようでした。
(Roku)
とても興味深い質問ですが ただ、緯度経度に関する内容が記述されていないので、第三者にはもう一歩の 感があります。 緯度経度位置計算には単なる平面状での位置関係だけでピタゴラス定理のみで は誤差を生じます。 地球は真円でなく扁平ですから位置により補正を求めます 私の場合、緯度経度を秒に表し２点間の距離を求めます 質問者の位置では小数点がありますから倍精度で変数宣言します 緯度経度間の距離計算には ・赤道半径 ・離芯率 ・扁平率 等で補正を掛け計算する必要があります。
詳しくは下記を参考
国土地理院HP http://vldb.gsi.go.jp/sokuchi/surveycalc/bl2stf.html
asami
ご指摘ありがとうございます。
地球上の二点間の距離についてヒュベニの公式ってやつを 使ったのですが、教えていただいた国土地理院HPの値とは だいぶ誤差が出てしまいますね。。 正確な二点間の距離を算出するにはどうすればいいでしょう？
本来は並べ替えさえ出来ればよかったのですが、調べていくと 奥が深いようで、より正確に出したくなっちゃいます。 国土地理院HPの公式をコーディングできればいいんでしょうが この式を理解できずコーディングできません・・
(Roku)
あ、連投すみません。 球形上の角度の計算方法も変わってきますね。。 考え方はそのままで角度の計算方法も考え直さないといけませんね。。
(Roku)
長距離通勤ゆえコードを作成するのは休日のみです。
２点間距離の計算を掲示しておきます。
時分秒を設定し補正をかけ距離を算出します。
緯度経度の小数点は考慮してません。
A B C D E F
緯度経度表記２点間距離
-------------------------------------------
４ 起点 Ａ
-------------------------------------------
５ 対地 緯度 軽度 距離
km
項番 Ｂ
-------------------------------------------
６ あ
-------------------------------------------
７ い
-------------------------------------------
８ う
-------------------------------------------
９ え
-------------------------------------------
10 お
-------------------------------------------
11 か
セルへの記入注意
起点の緯度：Ｄ４ 経度：Ｅ４ に設定（小数点無し）
対地の緯度：Ｄ６ 経度：Ｅ６ から下へ設定
緯度経度は文字列として認識し、時分秒を数字文字の位置 から検出し、全てを秒で表し計算。 計算結果をＦ列に表示
備考：緯度経度は２種類表記あり、混同しないこと ・日本測地 ・世界測地
Sub Com1()
Dim Ax As Double ' 起点経度
Dim Ay As Double ' 緯度
Dim Bx As Double
Dim By As Double
Dim Cx As Double
Dim Cy As Double
Dim Hx As Double ' 経度補正
Dim Hy As Double ' 緯度
Dim Km As Double ' ２点間距離
Dim R As Long ' 計算データ行数
Dim I As Long
Dim A As String
Dim B As String
A = Range("D4").Value ' 起点緯度
B = Range("E4").Value ' 経度
XY_Adjust Hx, Hy ' 補正値取得
Sec_Get A, B, Ay, Ax ' 基準点秒変換
Range("F6:F16").ClearContents
R = Range("C" & Rows.Count).End(xlUp).Row
For I = 6 To R
A = Val(Range("D" & I).Value) ' 対地緯度
B = Val(Range("E" & I).Value) ' 経度
Sec_Get A, B, By, Bx ' 秒変換
Cx = (Ax - Bx) * Hx ' 起点との差に補正値を乗じる
Cy = (Ay - By) * Hy
Km = Sqr((Cx ^ 2) + (Cy ^ 2)) ' 距離
Km = Km / 1000
Range("F" & I).Value = Format(Km, "###.###")
Next I
End Sub
' 緯度経度文字を秒へ変換
Sub Sec_Get(A As String, B As String, Y As Double, X As Double)
Y = Val(Mid(A, 1, 2)) * 3600 + Val(Mid(A, 3, 2)) * 60 + Val(Mid(A, 5, 2)) ' 緯度
X = Val(Mid(B, 1, 3)) * 3600 + Val(Mid(B, 4, 2)) * 60 + Val(Mid(B, 6, 2)) ' 経度
End Sub
Sub XY_Adjust(Xx As Double, Yy As Double) ' 扁平球面を補正
Dim Ax As Double
Dim Ay As Double
Dim Xr As Double
Dim Yr As Double
Dim K1 As Double
Dim K2 As Double
Dim K3 As Double
Dim K4 As Double
Dim PI As Double
PI = 3.141592654
K1 = 6378137 ' 赤道半径
K2 = 298.257222101 ' 扁平率の逆数
K3 = 1 / K2 ' 扁平率
K4 = 2 * K3 - (K3 ^ 2) ' 離心率の二乗
Ay = Val(Range("D4").Value) / 10000 ' 起点の緯度
Ax = Val(Range("E4").Value) / 10000 ' 経度
Xr = Ax / 180 * PI
Yr = Ay / 180 * PI
Yy = (PI / 648000) * K1 * (1 - K4) / (1 - K4 * (Sin(Yr)) ^ 2) ^ 1.5
Xx = PI / 180 / 3600 * K1 * Cos(Yr) / Sqr(1 - K4 * Sin(Yr) ^ 2)
End Sub
asamiです ichinoseさん紹介のページを拝見しますとその質問者の解法が、 VBで記述されております。 だいぶ以前にVB作成は致しましたがかなり忘れ、改めて参考書ではなく、 このサイトはEXCELですから、VBAに何とか置き換えられないかと約２週間 何度も元VBを見続けました、EXCELの機能（関数）を積極的に利用すると 簡単に、誰にでも理解し易いのではないかと思います。 以前の質問欄で今ではこの欄は参照する方は居ないでしょうが、この解法に 興味を持った者の一人としてあえて掲載しておきます。 各地点の緯度、経度を時分秒で４行目以降に入力し Com1 を呼び出すと、緯度経度を秒へ換算し、設定します。 この緯度秒列をソートし再表示し、最小緯度を基準点として、距離差を求め 角度を算出しセルへ記入します。 最後にこのような興味ある質問をしてくれたRokuさん、またVBサイトの紹介をされた ichinoseさんへ御礼を申し上げておきます。
Private Sub CommandButton1_Click()
com1
End Sub
Sub com1()
Dim PosX() As Double ' 経度
Dim PosY() As Double ' 緯度
Dim R As Long
Dim I As Long
R = Range("C" & Rows.Count).End(xlUp).Row - 3
ReDim PosX(R)
ReDim PosY(R)
For I = 1 To R
PosY(I) = Val(Range("B" & I + 3) * 3600) + Val(Range("C" & I + 3) * 60) + Val(Range("D" & I + 3))
PosX(I) = Val(Range("E" & I + 3) * 3600) + Val(Range("F" & I + 3) * 60) + Val(Range("G" & I + 3))
Range("H" & I + 3).Value = PosY(I) ' 緯度秒表示
Range("I" & I + 3).Value = PosX(I) ' 経度
Next
SortSec R ' 一旦全位置データを秒に表記し、緯度秒でソートする
Get_XY R, PosY(), PosX() ' 最小緯度を基準点とし、そこからの離れ位置で角度を算出
Range("A4") = "基準点"
Cells(1, 1).Select
End Sub
Sub Get_XY(R As Long, PosY() As Double, PosX() As Double)
Dim I As Long
Dim dx As Double
Dim dy As Double
Dim Pos As Double '基準点（最初の行に対しての位置）
'
For I = 2 To R
dx = PosX(I) - PosX(1) ' 経度差
dy = PosY(I) - PosY(1) ' 緯度
Pos = Abs(dy) / (Abs(dx) + Abs(dy))
If (dx < 0# And dy >= 0#) Then Pos = (1# - Pos) + 1#
Range("J" & I + 3).Value = dy ' 緯度差
Range("K" & I + 3).Value = dx ' 経度
Range("L" & I + 3).Value = Pos ' 角度正規値
Range("M" & I + 3).Value = Pos * 90 ' 基準点に対する角度
Next I
End Sub
Sub SortSec(R As Long) ' 緯度秒でソート
'
Range("A3:I" & R).Select
Selection.Sort Key1:=Range("H4"), Order1:=xlAscending _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End Sub
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.