2
$\begingroup$

1

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.

$\endgroup$
1

1 Answer 1

3
$\begingroup$
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}]

1 reference: Solve with inverse trig functions

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.