Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


28 / 13331 ツリー ←次へ | 前へ→

【80884】オートシェイプ辺り判定:円と回転する長方形 SHUN 19/6/6(木) 19:58 質問[未読]
【80886】Re:オートシェイプ辺り判定:円と回転する... γ 19/6/6(木) 23:04 発言[未読]
【80897】Re:オートシェイプ辺り判定:円と回転する... SHUN 19/6/12(水) 21:08 お礼[未読]

【80884】オートシェイプ辺り判定:円と回転する長...
質問  SHUN  - 19/6/6(木) 19:58 -

引用なし
パスワード
   VBAで作るゲームの質問です。

自分で操作する円形のオートシェイプと、自動で回転する長方形のオートシェイプの
当たり判定はどうすればよいでしょうか??

円と円は三平方で、円と非回転の長方形は1辺との距離判定でクリアしましたが、
回転となるとわからなくなりました。

よろしくお願いいたします。

ちなみに円と円の衝突は以下のようにつくりました。

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
'円の作成
Sub MakeCircle()

Dim p1 As Single, p2 As Single
Dim s1 As Single, s2 As Single
Dim p3 As Single, p4 As Single
Dim s3 As Single, s4 As Single

With Selection
 p1 = 50  '左端からの位置
 p2 = 200 '上端からの位置
 s1 = 20  '図形の横幅
 s2 = 20  '図形の縦幅
 p3 = 200
 p4 = 200
 s3 = 40
 s4 = 40
 
End With

'自機を作成
ActiveSheet.Shapes.AddShape(msoShapeOval, p1, p2, s1, s2).Name = "circle1"
With ActiveSheet.Shapes("circle1")
  '図形の背景色青
  .Fill.ForeColor.RGB = vbBlue
  '図形の枠線を無しに設定
  .Line.Visible = False
End With

'敵機を作成
ActiveSheet.Shapes.AddShape(msoShapeOval, p3, p4, s3, s4).Name = "circle2"
With ActiveSheet.Shapes("circle2")
  .Fill.ForeColor.RGB = vbRed
  .Line.Visible = False
End With

End Sub


'円の移動
 Sub MoveCircle()

 Dim crc1 As Object
 Dim crc2 As Object
 
 Dim x1 As Single
 Dim x2 As Single
 Dim y1 As Single
 Dim y2 As Single
 
 Dim rx As Single


 'オブジェクト変数に図形を入れる
 Set crc1 = ActiveSheet.Shapes("circle1")
 Set crc2 = ActiveSheet.Shapes("circle2")


 Do
 
 If GetAsyncKeyState(40) <> 0 Then '下
    If crc1.Top < 300 Then
    crc1.Top = crc1.Top + 10
    Else
    crc1.Top = crc1.Top
    End If
 End If
 
 If GetAsyncKeyState(38) <> 0 Then '上
    If crc1.Top > 40 Then
    crc1.Top = crc1.Top - 10
    Else
    crc1.Top = crc1.Top
    End If
 End If
 
 If GetAsyncKeyState(39) <> 0 Then '右
    If crc1.Left < 300 Then
    crc1.Left = crc1.Left + 10
    Else
    crc1.Left = crc1.Left
    End If
 End If
 
 If GetAsyncKeyState(37) <> 0 Then '左
    If crc1.Left > 40 Then
    crc1.Left = crc1.Left - 10
    Else
    crc1.Left = crc1.Left
    End If
 End If
    
 '1 〜 4 の乱数を発生
 Randomize
 
 rd = Int(Rnd * 4 + 1)

 '得られた乱数によって敵機ランダム移動
 Select Case rd

 Case 1
  If crc2.Top < 280 Then
  crc2.Top = crc2.Top + 20
  Else
  crc2.Top = crc2.Top
  End If

 Case 2
  If crc2.Top > 40 Then
  crc2.Top = crc2.Top - 20
  Else
  crc2.Top = crc2.Top
  End If
  
 Case 3
  If crc2.Left < 280 Then
  crc2.Left = crc2.Left + 20
  Else
  crc2.Left = crc2.Left
  End If
  
 Case Else
  If crc2.Left > 40 Then
  crc2.Left = crc2.Left - 20
  Else
  crc2.Left = crc2.Left
  End If

 End Select


 '当たり判定:ゲームオーバー
 x1 = crc1.Left + crc1.Width / 2
 y1 = crc1.Top + crc1.Height / 2
 x2 = crc2.Left + crc2.Width / 2
 y2 = crc2.Top + crc2.Height / 2
 rx = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
 
  If rx < 30 Then

  
  MsgBox "ゲームオーバー"
  
  crc1.Delete
  crc2.Delete
  
  
  Exit Do
  
  End If
 
 
 'Enterでゲーム終了

  If GetAsyncKeyState(13) <> 0 Then
    
  crc1.Delete
  crc2.Delete
  
  Exit Do
  
  End If


 '処理間隔を 0.1 秒に設定
 Application.Wait [Now() + "0:00:00.1"]

 Loop
 

 End Sub

【80886】Re:オートシェイプ辺り判定:円と回転す...
発言  γ  - 19/6/6(木) 23:04 -

引用なし
パスワード
   >円と円は三平方で、円と非回転の長方形は1辺との距離判定でクリアしましたが、
>回転となるとわからなくなりました。
長方形の回転角をθとすると、
長方形の中心を回転中心として、両者をーθ回転すれば、
回転無しの長方形と円との交点判定に帰着できるはずですが。

【80897】Re:オートシェイプ辺り判定:円と回転す...
お礼  SHUN  - 19/6/12(水) 21:08 -

引用なし
パスワード
   画面には反映させず設定上のみ‐θ回転方法がわからなかったので、この方法ではできませんでしたが、点と直線の距離を使って自力で解決しました。

▼γ さん:
>>円と円は三平方で、円と非回転の長方形は1辺との距離判定でクリアしましたが、
>>回転となるとわからなくなりました。
>長方形の回転角をθとすると、
>長方形の中心を回転中心として、両者をーθ回転すれば、
>回転無しの長方形と円との交点判定に帰着できるはずですが。

28 / 13331 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free