# Regarding the interactive operation of a four-bar linkage mechanism

I have a four-bar linkage mechanism, where when the left locator is moved, the right locator moves accordingly, and when the right locator is moved, the left locator moves accordingly. I have implemented this using DynamicModule + Locator:

Clear["*"]; ptX = {0, 0}; p = 3;
DynamicModule[{}, {C1, r1} = {{0, 0}, 2};
{C2, r2} = {{3, 0}, 2}; {p1, p2} = {{0, 2}, {3.5, 2}};
Graphics[{{Thickness[.003], Darker@Green, Line[{p1, p2} // Dynamic]},
{Thickness[.003], Orange, Line[{p2, {p, 0}} // Dynamic]},
{Thickness[.003], Blue,
Line[{ptX, p1} //
Dynamic]}, {ParametricPlot[{{2 Cos[u], 2 Sin[u]}, {2 Cos[u] + 3,
2 Sin[u]}}, {u, 0, 2 Pi}][[1]]}, {Locator[
Dynamic[p1, (p1 = C1 + r1 Normalize[# - C1];
sola = Solve[
EuclideanDistance[
p1, {2 Cos[\[Phi]b0] + 3, 2 Sin[\[Phi]b0]}] == 3.5 &&
0 <= \[Phi]b0 <= 2 Pi, \[Phi]b0, Reals][[1]] // Quiet;
p2 = {2 Cos[\[Phi]b0] + 3, 2 Sin[\[Phi]b0]} /. sola) &]],
Locator[Dynamic[
p2, (p2 = C2 + r2 Normalize[# - C2];
solb = Solve[
EuclideanDistance[
p2, {2 Cos[\[Phi]a0], 2 Sin[\[Phi]a0]}] == 3.5 &&
0 <= \[Phi]a0 <= 2 Pi, \[Phi]a0, Reals][[1]] // Quiet;
p1 = {2 Cos[\[Phi]a0], 2 Sin[\[Phi]a0]} /. solb) &]]}},
PlotRange -> {{-5, 8}, {-5, 7}}, Axes -> True, ImageSize -> 420],
SaveDefinitions -> True]


Now I want to use the Manipulate function along with slidebars to complete this coupled system. Slidebar 1 controls the coordinates (rotation angle) of the left locator, and slidebar 2 controls the coordinates (rotation angle) of the right locator. Moving one slidebar should affect the other slidebar. How can I implement this operation?

The final goal is to create an animation: after the blue link rotates counterclockwise by a certain angle, the orange link rotates clockwise by a certain angle.

• Commented Mar 18 at 21:48

Clear["*"]; c = 12/2; b = 9; a = 9; len = 9;
eqa = TrigExpand[(2 c + a Cos[u[t]] - b Cos[t])^2 + (a Sin[u[t]] -
b Sin[t])^2 - len^2 == 0];
sola = 2 ArcTan[uu] /.
Solve[eqa /. u[t] -> 2 ArcTan[uu] // TrigExpand, uu] // Quiet;
a1[t_] = sola[[1]]; a2[t_] = sola[[2]];
eqb = TrigExpand[(2 c + a Cos[t] - b Cos[u[t]])^2 + (a Sin[t] -
b Sin[u[t]])^2 - len^2 == 0];
solb = 2 ArcTan[uu] /.
Solve[eqb /. u[t] -> 2 ArcTan[uu] // TrigExpand, uu] // Quiet;
b1[t_] = solb[[1]]; b2[t_] = solb[[2]];
plotb = Plot[{b2[t], b1[t]}, {t, 0, 2 Pi}, PlotPoints -> 30,
AspectRatio -> Automatic, PlotLegends -> "Expressions"];
plota = Plot[{a2[t], a1[t]}, {t, 0, 2 Pi}, PlotPoints -> 30,
AspectRatio -> Automatic, PlotLegends -> "Expressions"];
{plota, plotb}
origin = {0, 0}; list = {};
Manipulate[
Which[action == "Rotate Blue",
Which[funca == "a1", \[Phi]b = a1[\[Phi]a],
funca == "a2", \[Phi]b = a2[\[Phi]a]],
action == "Rotate orange",
Which[funcb == "b1", \[Phi]a = b1[\[Phi]b],
funcb == "b2", \[Phi]a = b2[\[Phi]b]]];
p2 = {a Cos[\[Phi]b] + 2 c, a Sin[\[Phi]b]};
p1 = {b Cos[\[Phi]a], b Sin[\[Phi]a]}; mid = (p1 + p2)/2;
solp3 = Solve[
EuclideanDistance[mid, {x, y}] == 4 &&
Dot[p1 - p2, mid - {x, y}] == 0, {x, y}, Reals] // Quiet;
p3 = Sort[{x, y} /. solp3,
EuclideanDistance[#1, {0, 0}] > EuclideanDistance[#2, {0, 0}] &][[
1]]; AppendTo[list, p3];
Show[Graphics[{{Transparent, Circle[{0, 0}, b + 1],
Circle[{2 c, 0}, a + 1]}, {Point[p3], Line[{p3, p2}],
Line[{p3, p1}], Thickness[.003], Darker@Green, Line[{p1, p2}],
Thickness[.003], Orange, Line[{p2, {2 c, 0}}], Thickness[.003],
Blue, Line[{origin, p1}]}},
PlotRange -> All(*{{-5,8},{-5,7}}*), Axes -> False,
ImageSize -> 420],
ListPlot[list, PlotStyle -> Red]], {{\[Phi]a, 0, "Blue"}, -Pi,
2 Pi, .1, Appearance -> "Open"}, {{\[Phi]b, 2.88, "orange"}, -Pi,
2 Pi, .1, Appearance -> "Open"},
Control[{{action, "Rotate Blue", "action"}, {"Rotate Blue",
"Rotate orange"}}],
Control[{{funca, "a1", "funca"}, {"a1", "a2"}}],
Control[{{funcb, "b2", "funcb"}, {"b1", "b2"}}],
ControlPlacement -> Top, SaveDefinitions -> True,
TrackedSymbols :> {\[Phi]a, \[Phi]b}]


reference: Solve with inverse trig functions