|
ちくたく さん へ
ご回答ありがとうございます。
>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
|
|