# Solving 2-D Mechanical Systems

I'm trying to use Mathematica to solve a particular 2-d mechanical system. The system comes from "DESIGN AND OPTIMIZATION OF AN EIGHT-BAR LEGGED WALKING MECHANISM IMITATING A KINETIC SCULPTURE, “WIND BEAST”" paper and looks like this (illustrations from the paper):

I'm focusing first on the orange part of the leg:

  system =
a0x == 0 && a0y == 0 &&
ax == z2*Cos[t] && ay == z2*Sin[t] &&
(bx - ax)^2 + (by - ay)^2 ==  z3^2 &&
(bx - b0x)^2 + (by - b0y)^2 == z4^2 &&
b0x == -z1 && b0y == 0 &&
(ex - b0x)^2 + (ey - b0y)^2 ==  z6^2 &&
(ex - ax)^2 + (ey - ay)^2 == z5^2 &&
z1 == 15 && z2 == 2.78 && z3 == 20.02 && z4 == 12 && z5 == 20.02 && z6 == 12.0


Now I was hoping that I would be able to use Reduce[system, {ex}] or some combination of Solve but it doesn't seem to work. Reduce[Eliminate[system, {ax, ay, a0x, a0y, bx, by, b0x, b0y, ey, z1, z2, z3, z4, z5, z6}], {ex}] gives bunch of equations but the output does not look nice. Is this my best option? How can I process it output further in automatic way?

I'm seeking for any other approach to analyze such kinds of constraint-based system with Mathematica. Numeric solutions (aka simulation) would be perfectly fine).

PS I looked at system modeler, but it seems too complicated (and too expensive) for my task.

Similar question: How can I simulate this toggle mechanism?

{z1 = 15, z2 = 139/50, z3 = 1001/50, z4 = 12, z5 = 1001/50, z6 = 12};
{a0x = 0, a0y = 0, b0x = -z1, b0y = 0};
newsys = {ax == z2 Cos[t],
ay == z2 Sin[t], (-ax + bx)^2 + (-ay + by)^2 == z3^2,
(-b0x + bx)^2 + (-b0y + by)^2 == z4^2, (-b0x + ex)^2 + (-b0y + ey)^2 == z6^2,
(-ax + ex)^2 + (-ay + ey)^2 == z5 ^2} /.
v_Symbol /; Context[v] === "Global" && v =!= t :> v[t];
initpos = Equal @@@ Block[{t = 0},
NSolve[newsys][[3]]                 (* the 3rd one has B != E *)
];
{sol} = NDSolve[{newsys, initpos,
s'[t] == 1, s[0] == 0},               (* needed for integration of system *)
Union@Cases[newsys, (v_)[t] /; Context[v] === "Global" :> v, Infinity],
{t, 0, 2 Pi}];

points[t_] = {{a0x, a0y}, {ax[t], ay[t]}, {bx[t], by[t]}, {b0x, b0y}, {ex[t], ey[t]}};
mov = Table[
Graphics[{Point[points[t]],
Line[points[t]~Append~{ax[t], ay[t]}]} /. sol,
PlotRange -> {{-20, 3}, {-13, 13}}],
{t, 0, 2 Pi, Pi/10}];


• Thank you, this is exactly what I was looking for! Commented Jan 18, 2015 at 1:21
• I didn't get this (v_)[t] /; Context[v] === "Global" :> v, Infinity though. Why are you replacing every function by infinity? Commented Jan 18, 2015 at 1:42
• @mikea The code to try out is Cases[newsys, (v_)[t] /; Context[v] === "Global" :> v, Infinity]. Look up Cases in the docs. The Infinity is the level. It grabs all the functions ax[t] etc. and replaces them with just ax. You could just list them by hand. I did it because, if you change the functions, you don't have to change the Cases` statement. It took a couple of tries to sort out the variables. My eyes are a bit weak and looking through someone else's code carefully is sometimes a challenge. I'd rather have M look through it for me. :) Commented Jan 18, 2015 at 1:55