NOBのArduino日記！

NOBのArduino日記！

趣味は車・バイク・自転車・ラジコン・電子工作です。

Gamebuinoで自作ゲーム！その4(テオ・ヤンセン機構 1脚シミュレート！)

Arduino #工学
イメージ 1
テオ・ヤンセン機構(Jansen's Linkage)1脚シミュレート！
 
 前回の記事 では、リンク軸の座標をEXCELワークシートで計算し、これをVBAでアニメーション化しました。
 これはパラメータを調整し易くて良いのですが、若干スマートさに欠けます
 と言う事で、今回は前々回の記事で作った座標計算式と前回の記事で作ったアニメーション化プログラムを一つのVBAプログラムにまとめてみました！セルへの大量アクセスが無くなってスッキリです！

1. プログラム！

 1.1 導入
 EXCLファイルを「xlsm」拡張子で保存します。
 このEXCELファイルを開いた状態で「開発」タブ→「Visual Basic」を押すと「Microsoft Visual Basic for Applications」(VBA)が開きます。
 VBA画面左上に「プロジェクト-VBAProject」ウインドウが有り、そこにはファイルのツリー構造が示されていますので、その中から現在編集しているEXCELファイル名(***)の「VBAProject(***_xlsm)」→「Microsoft Excel Objects」→から現在編集しているEXCELのシート名を選択し、下記プログラムコードを張り付けて保存するだけでOKです！
※VBAの流れに関する詳細はコチラ
 
1.2 使い方
  EXCELワークシートのA1セルに動かしたい角度を入力しENTERを押すだけで、下記VBAプログラムが実行されます。
 プログラムの内容としては0°～入力した角度まで10°刻みで変化させ、この時のA～G座標の計算を行います。※今回追加分
 計算された座標を元にEXCELのオートシェープ(線と丸)の消去と描画を繰り返し「テオ・ヤンセン機構」をアニメーションで描画します。
 
Dim PI As Double
Sub Worksheet_Change(ByVal TARGET As Excel.Range)
'NOBのArduino日記！(20170828作成)
If TARGET.Address = "$A$1" Then
    '定数の宣言
    Const a As Double = 120, b As Double = 123, c As Double = 120, d As Double = 120, e As Double = 171, f As Double = 120, g As Double = 111, h As Double = 198, i As Double = 144, j As Double = 153, k As Double = 189, l As Double = 24, m As Double = 45, Ox As Double = 347, Oy As Double = 127
    PI = 3.14159
 
    '変数の宣言
    Dim Ax As Double, Bx As Double, Cx As Double, Dx As Double, Ex As Double, Fx As Double, Gx As Double, Ay As Double, By As Double, Cy As Double, Dy As Double, Ey As Double, Fy As Double, Gy As Double, Cθ As Double, Eθ As Double, Fθ As Double, Gθ As Double, Cxc As Double, Dxc As Double, Exc As Double, Fxc As Double, Gxc As Double, Cyc As Double, Dyc As Double, Eyc As Double, Fyc As Double, Gyc As Double, AB As Double, DE As Double
 
    '処理
    For θ = 0 To TARGET.Value Step 10
 
        '座標A計算
        Ax = Ox + m * Cos(Radians(θ))
        Ay = Oy + m * Sin(Radians(θ))
 
        '座標B計算
        Bx = Ox - a
        By = Oy + l
 
        '座標C計算
        AB = ( (Ax - Bx) ^ 2 + (By - Ay) ^ 2) ^ 0.5
        Cθ = Atn( (Ay - By) / (Ax - Bx))
        Cxc = (AB ^ 2 + b ^ 2 - j ^ 2) / (2 * AB)
        Cyc = (b ^ 2 - Cxc ^ 2) ^ 0.5
        Cx = Bx + Cxc * Cos(Cθ) + Cyc * Cos(Cθ - PI / 2)
        Cy = By + Cxc * Sin(Cθ) + Cyc * Sin(Cθ - PI / 2)
 
        '座標D計算
        Dxc = (AB ^ 2 + c ^ 2 - k ^ 2) / (2 * AB)
        Dyc = (c ^ 2 - Dxc ^ 2) ^ 0.5
        Dx = Bx + Dxc * Cos(Cθ) + Dyc * Cos(Cθ + PI / 2)
        Dy = By + Dxc * Sin(Cθ) + Dyc * Sin(Cθ + PI / 2)
 
        '座標E計算
        Eθ = Acos( (Bx - Cx) / b) + PI
        Exc = (b ^ 2 + d ^ 2 - e ^ 2) / (2 * b)
        Eyc = (d ^ 2 - Exc ^ 2) ^ 0.5
        Ex = Bx + Exc * Cos(Eθ) + Eyc * Cos(Eθ - PI / 2)
        Ey = By + Exc * Sin(Eθ) + Eyc * Sin(Eθ - PI / 2)
 
        '座標F計算
        DE = ( (Dx - Ex) ^ 2 + (Dy - Ey) ^ 2) ^ 0.5
        Fθ = Atn( (Ey - Dy) / (Ex - Dx))
        Fxc = (DE ^ 2 + g ^ 2 - f ^ 2) / (2 * DE)
        Fyc = Abs(g ^ 2 - Fxc ^ 2) ^ 0.5
        Fx = Dx - Fxc * Cos(Fθ) - Fyc * Cos(Fθ - PI / 2)
        Fy = Dy - Fxc * Sin(Fθ) - Fyc * Sin(Fθ - PI / 2)
 
        '座標G計算
        Gθ = Atn( (Fy - Dy) / (Fx - Dx))
        Gxc = (g ^ 2 + i ^ 2 - h ^ 2) / (2 * g)
        Gyc = (i ^ 2 - Gxc ^ 2) ^ 0.5
        Gx = Dx - Gxc * Cos(Gθ) - Gyc * Cos(Gθ - PI / 2)
        Gy = Dy - Gxc * Sin(Gθ) - Gyc * Sin(Gθ - PI / 2)
 
        Dim axis As Variant, AOx As Variant, AOy As Variant, link As Variant, AOx1 As Variant, AOy1 As Variant, AOx2 As Variant, AOy2 As Variant
        'リンク軸座標格納
        axis = Array("A", "B", "C", "D", "E", "F", "G", "O")
        AOx = Array(Ax, Bx, Cx, Dx, Ex, Fx, Gx, Ox)
        AOy = Array(Ay, By, Cy, Dy, Ey, Fy, Gy, Oy)
        'リンク座標格納 b   c   d   e   f   g   h   i   j   k   m
        link = Array("b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "m")
        AOx1 = Array(Bx, Bx, Bx, Cx, Ex, Dx, Fx, Dx, Ax, Ax, Ox)
        AOy1 = Array(By, By, By, Cy, Ey, Dy, Fy, Dy, Ay, Ay, Oy)
        AOx2 = Array(Cx, Dx, Ex, Ex, Fx, Fx, Gx, Gx, Cx, Dx, Ax)
        AOy2 = Array(Cy, Dy, Ey, Ey, Fy, Fy, Gy, Gy, Cy, Dy, Ay)
 
        'オートシェイプ削除
        For Each ee In ActiveSheet.Shapes
            ActiveSheet.Shapes(1).Delete
        Next
 
        'b～mのリンク・記号を描画
        For jj = 0 To 10
            'リンク
            With ActiveSheet.Shapes.AddLine(AOx1(jj), AOy1(jj), AOx2(jj), AOy2(jj)).Line
                .ForeColor.RGB = RGB(255, 0, 0)
                .Weight = 0.75
            End With
            'リンク記号
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, (AOx1(jj) + AOx2(jj)) / 2 - 10, (AOy1(jj) + AOy2(jj)) / 2 - 10, 48.75, 43.5).Select
            With Selection.ShapeRange
                .Fill.Visible = msoFalse
                .Line.Visible = msoFalse
                .TextFrame2.TextRange.Characters.Text = link(jj)
                .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
                .TextFrame2.TextRange.Characters.Font.Size = 11
            End With
        Next jj
 
        '軸ポイント
        With ActiveSheet.Shapes
            .AddShape msoShapeOval, Ox - 5, Oy - 5, 10, 10  'O
            .AddShape msoShapeOval, Bx - 5, By - 5, 10, 10  'B
            .AddShape msoShapeOval, Gx - 5, Gy - 5, 10, 10  'G
        End With
 
        '軸記号
        For kk = 0 To 7
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, AOx(kk) - 10, AOy(kk) - 10, 48.75, 43.5).Select
            With Selection.ShapeRange
                .Fill.Visible = msoFalse
                .Line.Visible = msoFalse
                .TextFrame2.TextRange.Characters.Text = axis(kk)
                .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
                .TextFrame2.TextRange.Characters.Font.Size = 11
            End With
        Next kk
 
        Range("O4").Select
        DoEvents
    Next θ
End If
End Sub
Function Radians(Degrees As Variant) As Variant
    '角度からラジアンを求る
    Radians = (PI / 180) * Degrees
End Function
Function Acos(x As Variant) As Variant
    'アークコサインを求める
    Select Case x
      Case Is = -1
        Acos = PI
      Case Is = 1
        Acos = 0
      Case Else
        Acos = PI / 2 - Atn(x / Sqr(1 - x ^ 2))
    End Select
End Function






VBAプログラムコード：「テオ・ヤンセン機構」をVBAだけでシミュレート！






 




2. まとめ




 今回の改良で「テオ・ヤンセン機構」による脚の動き(一本)をVBAだけでシミュレート出来る様になりました！


 次は前足と後ろ足の「二脚」シミュレート出来る様にプログラムのバージョンアップ中です！



 



イメージ 1  イメージ 3


励みになりますのでよければクリック下さい(^o^)/



↩【Gamebuinoで自作ゲーム！】目次に戻る