| |
しろうと さん へ
こんにちは、回答になるか分かりませんが気になった点をいくつか
ＩＦ文についてなんですが
>If AminY <= BminY <= AmaxY Then
If AminY <= BminY And BminY<= AmaxY Then としたら良いのではないでしょうか？
次に、四角の干渉条件ですが、
BminX<AminX かつ BmaxX>AmaxX かつ BminY>AminY かつ BmaxY<AmaxY と
BminX>AminX かつ BmaxX<AmaxX かつ BminY<AminY かつ BmaxY>AmaxY の（貫通といったらよいのか分かりませんが）条件が抜けているのではないですか？
>ちくたく さん へ
>
>ご回答ありがとうございます。
>
>>AutoCADをもってらっしゃいませんか？
>
>残念ながら，AutoCADは持っておりません。
>
>自分でも考えてみたのですが，うまく機能致しません。
>
>以下に記載させて頂きます。
>
>もし，訂正箇所がございましたら，ご指摘いただけると幸いです。
>
>以上，よろしくお願い致します。
>
>Sub Check_contact()
>
>Dim N, M, ans As Integer
>Dim AminX, AmaxX, AminY, AmaxY, BminX, BmaxX, BminY, BmaxY As Single
>Dim msglist(0) As String
>
> msglist(0) = "長方形同士が接触している可能性があります。" & vbCrLf & vbCrLf & _
> "該当長方形の名称のセル背景は黄色で表示されています。 " & vbCrLf & vbCrLf & _
> "該当長方形の[中心座標]および[サイズ] の数値を" & vbCrLf & _
> "再チェックし，正しい数値を入力してください。"
>
>'A:元の長方形,B:比較対象の長方形
>
>For N = 17 To 65
> If Cells(N, 4) = 1 Then 'if1
> For M = N + 1 To 66
> If Cells(M, 4) = 1 Then 'if2
>
> AminX = Cells(N, 6).value - Cells(N, 9).value / 2
> AmaxX = Cells(N, 6).value + Cells(N, 9).value / 2
> BminX = Cells(M, 6).value - Cells(M, 9).value / 2
> BmaxX = Cells(M, 6).value + Cells(M, 9).value / 2
>
> AminY = Cells(N, 7).value - Cells(N, 10).value / 2
> AmaxY = Cells(N, 7).value + Cells(N, 10).value / 2
> BminY = Cells(M, 7).value - Cells(M, 10).value / 2
> BmaxY = Cells(M, 7).value + Cells(M, 10).value / 2
>
> If AminX <= BminX <= AmaxX Then 'if3
>
> If AminY <= BminY <= AmaxY Then 'if4
>
> Cells(N, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
> Cells(M, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
>
> ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
> End
>
> ElseIf AminY <= BmaxY <= AmaxY Then 'if4
>
> Cells(N, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
> Cells(M, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
>
> ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
> End
>
> End If 'if4
>
> End If 'if3
>
> If AminX <= BmaxX <= AmaxX Then 'if5
>
> If AminY <= BminY <= AmaxY Then 'if6
>
> Cells(N, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
> Cells(M, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
>
> ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
> End
>
> ElseIf AminY <= BmaxY <= AmaxY Then 'if6
>
> Cells(N, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
> Cells(M, 5).Select
> With Selection.Interior
> .ColorIndex = 36
> .Pattern = xlSolid
> End With
>
> ans = MsgBox(msglist(0), 65552, "パラメータ設定エラー")
> End
>
> End If 'if6
>
> End If 'if5
>
> End If 'if2
> Next M
> End If 'if1
>Next N
>
>End Sub
|
|
わいわい
- 06/4/11(火) 11:33 -
