Tracing the line of motion of a point in graphics

Question

I'm a beginner in mathematica. I'm making a nb that calculates the output angle of a fourbar mechanism based on the input angle. So the input is the length of the four linkages and the input angle of the crank and the output is the angle of rocker.

I've already made my code and it works well. I plot it in a graphics as well. Now I want to trace the point B which is the TIP of the coupler. I want to trace the path of motion of this point to plot the output curve.

outputAngle[r1_, r2_, r3_, 
  r4_, ϕ_] := (* r1 is the crank; r2 is the coupler; r3 is the \
rocker; r4 is the link between oA and oB; ϕ is the input angle \
of the crank; This function calculates the output angle of the \
rocker.*)
 {a1 = N[Sin[ϕ Degree]],
  b1 = N[r4/r1 + Cos[ϕ Degree]],
  c1 = N[r4/r3 Cos[ϕ Degree] + 
     N[(r1^2 - r2^2 + r3^2 + r4^2)/(2 r1 r2)]],
  ψ = 
   2 ArcTan[N[(a1 + √(a1^2 + b1^2 - c1^2))/(b1 + c1)]]/ 
     Degree,(*Output Angle Calculated by Equation from the refrence*)

    a2 = N[AngleVector[{r1, ϕ Degree}]],(*point A Starting from \
origin*)

  b2 = N[AngleVector[{-r4, 
      0}, {r3, ψ  Degree}]],(*Point B Starting from Ob*)

  N[AngleVector[{-r4, 0}]],(*Point oB*)

  d = √((b2[[1]] - a2[[1]])^2 + (b2[[2]] - 
        a2[[2]])^2) (*distance between A & B This is just to confirm \
that a2's length is constant*)
  }

Slider[Dynamic[t], {0, 720, 1}]

Dynamic[
 m = outputAngle[2, 8, 6, 6, 
   t]  (*This is the passing of values to the main function that \
calculates the output angle*)
 ]

Dynamic[ (*This is the drawing of the four bar linkage out put*)

 Graphics[{
   Line[{{0, 0}, m[[5]]}],
   Line[{m[[5]], m[[6]]}],
   Line[{m[[7]], m[[6]]}],
   Line[{{0, 0}, m[[7]]}],
   Locator[m[[6]]]
   }, Axes -> True, PlotRange -> {{-9, 6}, {-3, 8}}]
 ]

That is my code. I made sure to comment all the inputs so it makes sense. I need to trace the point B or m[[6]] in the graphics area. Any help?

Answer 1

I thought I would show you what I meant in my comment, together with the end product of my proposed modification, so you can decide if that's acceptable for your application. I am using all your definitions from the original questions.

I calculated the path as a Line object generated from a series of points calculated by your outputAngle function over the full range of motion (i.e. one full turn of the crank). Here I am assuming that your t represents the crank angular position in degrees, so its full range is $(0, 360)$.

I then added path inside your Graphics expression as the first object, so it sits below the locator and other lines and doesn't obscure them.

Finally, I slightly enlarged your explicit PlotRange to add some space to the left of the plot, otherwise the path line went right up against the Graphics bounding box. This is just aesthetics though; it would work with your original PlotRange just as well.

path = Line@Table[outputAngle[2, 8, 6, 6, t][[6]], {t, 0, 360, 1}];

Dynamic[
 Graphics[{
   (* Here is the traced path *)
   {Red, Thick, Dashed, path},
   (* These are your original linkages *)
   Line[{{0, 0}, m[[5]]}],
   Line[{m[[5]], m[[6]]}],
   Line[{m[[7]], m[[6]]}],
   Line[{{0, 0}, m[[7]]}],
   Locator[m[[6]]]
   },
  Axes -> True,
  PlotRange -> {{-9.5, 6}, {-3, 8}}
  ]
]

---

Update:

You mentioned that you would like to make the definitions for the current configuration of the linkages in one place. One way to achieve that is by modifying your definition of outputAngle to be a pure function which takes only the configuration parameters, and output expressions for angles and positions still as a function of an undefined variable (look up #, Slot in the docs).

You can then apply this pure function to the t variable when you need the numerical values.

While I was at it, I also modified the Line code in your Dynamic[Graphics[...]] to showcase the use of multiple points to generate a series of connected segments with a single Line expression.

Here is the modified code:

Clear[outputAngle, currentConfiguration]

outputAngle[r1_, r2_, r3_, r4_] =
  {
    a1 = N[Sin[# Degree]], b1 = N[r4/r1 + Cos[# Degree]],
    c1 = N[r4/r3 Cos[# Degree] + N[(r1^2 - r2^2 + r3^2 + r4^2)/(2 r1 r2)]],
    ψ = 2 ArcTan[N[(a1 + Sqrt[a1^2 + b1^2 - c1^2])/(b1 + c1)]]/Degree,
    a2 = N[AngleVector[{r1, # Degree}]],
    b2 = N[AngleVector[{-r4, 0}, {r3, ψ Degree}]],
    N[AngleVector[{-r4, 0}]],
    d = Sqrt[(b2[[1]] - a2[[1]])^2 + (b2[[2]] - a2[[2]])^2]
    } &;

(* Here is the one place where you set the configuration of your linkage *)
currentConfiguration = outputAngle[2, 8, 6, 6];

(* Now calculate the full path of the rocker *)
path = Line@Table[currentConfiguration[t][[6]], {t, 0, 360, 1}];

Slider[Dynamic[t], {0, 720, 1}]
Dynamic[m = currentConfiguration[t]]

Dynamic[Graphics[{
   (* The path of the rocker *)
   {Red, Dashed, path},
   (* The linkages *)
   Line[{{0, 0}, m[[5]], m[[6]], m[[7]], {0, 0}}],
   Locator[m[[6]]]},
  Axes -> True, PlotRange -> {{-9.5, 6}, {-3, 8}}
]]