前回までの「テオ・ヤンセン機構」のVBAプログラムでは、脚の数を変更するのにプログラムを修正しなければいけませんでしたが、今回は脚の数に応じた脚の色を自動配色するのと、描画条件(動作角度・脚の数・ステップ角度)を「InputBox関数」を使ってプログラム実行時に取得する事で脚の数を何本にでも自由に設定できる様にしました！
1. プログラム！
Dim PI As Variant
Sub JansenLinkage()
'NOBのArduino日記！多脚(20170829作成)
'入力要求
Dim buf(2) As Variant
buf(0) = InputBox(Prompt:="動作角度を入力してください。", Default:=180)
buf(1) = InputBox(Prompt:="足の数を入力してください。(最大20)", Default:=4) - 1
buf(2) = InputBox(Prompt:="ステップ角度を入力してください。(1以上)", Default:=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
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計算※OK!
Ax(Z) = Ox + m * Cos(Radians(θ + 360 / (buf(1) + 1) * Z))
Ay(Z) = Oy + m * Sin(Radians(θ + 360 / (buf(1) + 1) * Z))
'座標B計算※OK!
Bx(Z) = Ox - a + ARZ * a
By(Z) = Oy + l
'座標C計算※OK!
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(ARZ / 2 * 255 / (Z / 10 + 1), Abs(Application.RoundUp(Z Mod 2, 0) - 1) * 255 / (Z / 10 + 1), Application.RoundUp(Z Mod 3, 0) * 255 / (Z / 10 + 1))
.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(Z) - 5, By(Z) - 5, 10, 10 'B
.AddShape msoShapeOval, Gx(Z) - 5, Gy(Z) - 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
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
3. まとめ
～ん、脚が多ければ良いってものでもないですね
前回の四脚歩行の方がゲーム映えしそうです
励みになりますのでよければクリック下さい(^o^)/
