テオ・ヤンセン機構(Jansen's Linkage)2脚シミュレート
やはりストランドビーストと言う為には前足と後ろ足が無いと格好がつきません
1. プログラム！
改良したVBAのプログラムは以下の通りです。
Dim PI As Variant
Sub JansenLinkage()
'NOBのArduino日記！二脚(20170828作成)
'入力要求
Dim buf(2) As Variant
buf(0) = 360 '動作角度を入力
buf(1) = 1 '足の数-1を入力
buf(2) = 10 'ステップ角度を入力
'定数の宣言
Const a As Variant = 77.2, b As Variant = 79.1, c As Variant = 77.2, d As Variant = 77.2, e As Variant = 110#, f As Variant = 77.2, g As Variant = 71.4, h As Variant = 127.4, i As Variant = 92.7, j As Variant = 98.5, k As Variant = 121.6, l As Variant = 15.4, m As Variant = 29#, Ox As Variant = 263, Oy As Variant = 96.7 '↑×0.6435
PI = 3.14159
'変数の宣言
Dim Ax(20) As Variant, Bx(20) As Variant, Cx(20) As Variant, Dx(20) As Variant, Ex(20) As Variant, Fx(20) As Variant, Gx(20) As Variant, Ay(20) As Variant, By(20) As Variant, Cy(20) As Variant, Dy(20) As Variant, Ey(20) As Variant, Fy(20) As Variant, Gy(20) As Variant, Cθ(20) As Variant, Eθ(20) As Variant, Fθ(20) As Variant, Gθ(20) As Variant, Cxc(20) As Variant, Dxc(20) As Variant, Exc(20) As Variant, Fxc(20) As Variant, Gxc(20) As Variant, Cyc(20) As Variant, Dyc(20) As Variant, Eyc(20) As Variant, Fyc(20) As Variant, Gyc(20) As Variant, AB(20) As Variant, DE(20) As Variant
'処理
For θ = 0 To buf(0) Step buf(2)
'オートシェイプ削除
For Each ee In ActiveSheet.Shapes
ActiveSheet.Shapes(1).Delete
Next
'足描画
For Z = 0 To buf(1)
Dim ARZ As Single: ARZ = Application.RoundUp(Z Mod 2, 0) * 2
'座標A計算
Ax(Z) = Ox + m * Cos(Radians(θ + 360 / (buf(1) + 1) * Z))
Ay(Z) = Oy + m * Sin(Radians(θ + 360 / (buf(1) + 1) * Z))
'座標B計算
Bx(Z) = Ox - a + ARZ * a
By(Z) = Oy + l
'座標C計算
AB(Z) = ( (Ax(Z) - Bx(Z)) ^ 2 + (By(Z) - Ay(Z)) ^ 2) ^ 0.5
Cθ(Z) = Atn( (Ay(Z) - By(Z)) / (Ax(Z) - Bx(Z)))
Cxc(Z) = (AB(Z) ^ 2 + b ^ 2 - j ^ 2) / (2 * AB(Z))
Cyc(Z) = (b ^ 2 - Cxc(Z) ^ 2) ^ 0.5
Cx(Z) = Bx(Z) + Cxc(Z) * Cos(Cθ(Z)) + Cyc(Z) * Cos(Cθ(Z) - PI / 2) - ARZ * Cxc(Z) * Cos(Cθ(Z))
Cy(Z) = By(Z) + Cxc(Z) * Sin(Cθ(Z)) + Cyc(Z) * Sin(Cθ(Z) - PI / 2) - ARZ * Cxc(Z) * Sin(Cθ(Z))
'座標D計算
Dxc(Z) = (AB(Z) ^ 2 + c ^ 2 - k ^ 2) / (2 * AB(Z))
Dyc(Z) = (c ^ 2 - Dxc(Z) ^ 2) ^ 0.5
Dx(Z) = Bx(Z) + Dxc(Z) * Cos(Cθ(Z)) + Dyc(Z) * Cos(Cθ(Z) + PI / 2) - ARZ * Dxc(Z) * Cos(Cθ(Z))
Dy(Z) = By(Z) + Dxc(Z) * Sin(Cθ(Z)) + Dyc(Z) * Sin(Cθ(Z) + PI / 2) - ARZ * Dxc(Z) * Sin(Cθ(Z))
'座標E計算
Eθ(Z) = Acos( (Bx(Z) - Cx(Z)) / b) + PI
Exc(Z) = (b ^ 2 + d ^ 2 - e ^ 2) / (2 * b)
Eyc(Z) = (d ^ 2 - Exc(Z) ^ 2) ^ 0.5
Ex(Z) = Bx(Z) + Exc(Z) * Cos(Eθ(Z)) + Eyc(Z) * Cos(Eθ(Z) - PI / 2) - ARZ * Eyc(Z) * Cos(Eθ(Z) - PI / 2)
Ey(Z) = By(Z) + Exc(Z) * Sin(Eθ(Z)) + Eyc(Z) * Sin(Eθ(Z) - PI / 2) - ARZ * Eyc(Z) * Sin(Eθ(Z) - PI / 2)
'座標F計算
DE(Z) = ( (Dx(Z) - Ex(Z)) ^ 2 + (Dy(Z) - Ey(Z)) ^ 2) ^ 0.5
Fθ(Z) = Atn( (Ey(Z) - Dy(Z)) / (Ex(Z) - Dx(Z)))
Fxc(Z) = (DE(Z) ^ 2 + g ^ 2 - f ^ 2) / (2 * DE(Z))
Fyc(Z) = Abs(g ^ 2 - Fxc(Z) ^ 2) ^ 0.5
Fx(Z) = Dx(Z) - Fxc(Z) * Cos(Fθ(Z)) - Fyc(Z) * Cos(Fθ(Z) - PI / 2) + ARZ * Fxc(Z) * Cos(Fθ(Z))
Fy(Z) = Dy(Z) - Fxc(Z) * Sin(Fθ(Z)) - Fyc(Z) * Sin(Fθ(Z) - PI / 2) + ARZ * Fxc(Z) * Sin(Fθ(Z))
'座標G計算
Gθ(Z) = Atn( (Fy(Z) - Dy(Z)) / (Fx(Z) - Dx(Z)))
Gxc(Z) = (g ^ 2 + i ^ 2 - h ^ 2) / (2 * g)
Gyc(Z) = (i ^ 2 - Gxc(Z) ^ 2) ^ 0.5
Gx(Z) = Dx(Z) - Gxc(Z) * Cos(Gθ(Z)) - Gyc(Z) * Cos(Gθ(Z) - PI / 2) + ARZ * Gxc(Z) * Cos(Gθ(Z))
Gy(Z) = Dy(Z) - Gxc(Z) * Sin(Gθ(Z)) - Gyc(Z) * Sin(Gθ(Z) - PI / 2) + ARZ * Gxc(Z) * Sin(Gθ(Z))
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(Z), Bx(Z), Cx(Z), Dx(Z), Ex(Z), Fx(Z), Gx(Z), Ox)
AOy = Array(Ay(Z), By(Z), Cy(Z), Dy(Z), Ey(Z), Fy(Z), Gy(Z), 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(Z), Bx(Z), Bx(Z), Cx(Z), Ex(Z), Dx(Z), Fx(Z), Dx(Z), Ax(Z), Ax(Z), Ox)
AOy1 = Array(By(Z), By(Z), By(Z), Cy(Z), Ey(Z), Dy(Z), Fy(Z), Dy(Z), Ay(Z), Ay(Z), Oy)
AOx2 = Array(Cx(Z), Dx(Z), Ex(Z), Ex(Z), Fx(Z), Fx(Z), Gx(Z), Gx(Z), Cx(Z), Dx(Z), Ax(Z))
AOy2 = Array(Cy(Z), Dy(Z), Ey(Z), Ey(Z), Fy(Z), Fy(Z), Gy(Z), Gy(Z), Cy(Z), Dy(Z), Ay(Z))
'b～mのリンク・記号を描画
For jj = 0 To 10
'リンク
With ActiveSheet.Shapes.AddLine(AOx1(jj), AOy1(jj), AOx2(jj), AOy2(jj)).Line
.ForeColor.RGB = RGB(Abs(Application.RoundUp( ( (Z + 4) Mod 4) / 10, 0) - 1) * 255, Abs(Application.RoundUp( ( (Z + 4) Mod 6) / 10, 0) - 1) * 255, Abs(Application.RoundUp( ( (Z + 4) Mod 5) / 10, 0) - 1) * 255)
.Weight = 0.75
End With
'リンク記号
ActiveSheet.Shapes.AddShape(msoShapeRectangle, (AOx1(jj) + AOx2(jj)) / 2 - 9, (AOy1(jj) + AOy2(jj)) / 2 - 8, 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 = 8
End With
Next jj
'軸ポイント描画
With ActiveSheet.Shapes
.AddShape msoShapeOval, Ox - 4, Oy - 5, 8, 8 'O
.AddShape msoShapeOval, Bx(Z) - 4, By(Z) - 5, 8, 8 'B
.AddShape msoShapeOval, Gx(Z) - 5, Gy(Z) - 5, 8, 8 'G
End With
'軸記号描画
For kk = 0 To 7
ActiveSheet.Shapes.AddShape(msoShapeRectangle, AOx(kk) - 9, AOy(kk) - 8, 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 = 8
End With
Next kk
Next Z
Range("A1").Select
DoEvents
Next θ
End Sub
Function Radians(Degrees As Variant) As Variant
'角度からラジアンを求る
Radians = (PI / 180) * Degrees
End Function
'アークコサインを求める
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
