| |
しとうとさん こんにちは。
すでに、皆さんがいろんな回答を寄せてらっしゃいますが、
干渉のチェックの部分だけ作ってみました。
考え方は
(1) 長方形１＆２の中心を結ぶ線分の角度 ang と距離 dist を計算。
(2) 角度 ang で長方形１の中心を切断する線分の距離 sect1 を
計算。
(3) 角度 ang で長方形２の中心を切断する線分の距離 sect2 を
計算。
(4) dist - (sect1 + sect2)/2 の正負に基づいて、干渉を判定。
Sub test()
Dim x1 As Double, y1 As Double, a1 As Double, b1 As Double, _
x2 As Double, y2 As Double, a2 As Double, b2 As Double
x1 = 0 '長方形１の中心のＸ座標
y1 = 0 '長方形１の中心のＹ座標
a1 = 10 '長方形１の横の長さ
b1 = 5 '長方形１の縦の長さ
x2 = 11 '長方形２の中心のＸ座標
y2 = 1 '長方形２の中心のＹ座標
a2 = 1 '長方形２の横の長さ
b2 = 1 '長方形２の縦の長さ
MsgBox InterCheck(x1, y1, a1, b1, x2, y2, a2, b2)
End Sub
Private Function InterCheck(x1 As Double, y1 As Double, a1 As Double, _
b1 As Double, x2 As Double, y2 As Double, a2 As Double, _
b2 As Double) As Boolean
Dim ang As Double, dist As Double, sect(2) As Double, chd As Double, _
Pi As Double
Pi = 4 * Atn(1)
If x1 = x2 Then
ang = Pi / 2
Else
ang = Abs(Atn((y1 - y2) / (x1 - x2)))
End If
dist = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ 0.5
sect(1) = sectLength(ang, a1, b1)
sect(2) = sectLength(ang, a2, b2)
chd = dist - (sect(1) + sect(2)) / 2
If chd <= 0 Then InterCheck = True Else InterCheck = False
End Function
Private Function sectLength(ang As Double, a As Double, b As Double) _
As Double
Dim ath As Double, Pi As Double
ath = Abs(Atn(b / a))
If ang < ath Then
sectLength = a / Cos(ang)
Else
sectLength = b / Sin(ang)
End If
End Function
|
|
平塚在住
- 06/4/11(火) 22:37 -
