Simulating a quick return mechanism

Question

Last time, I got a satisfying answer for simulating a toggle mechanism, just as expected. NDSolve is great. I tried playing with it (as a matter of fact, @MichaelE2 left me with an exercise).

Now, I'm trying to simulate the quick return mechanism (to incorporate that in another video of mine). In the toggle mechanism, the crank drives another crank by transmitting power through the connecting rod.

But here, the crank itself drives the connecting rod whose end is fixed at some distance directly below the crank's center. The crank rotates. But since that drives the link fixed to one end, it slides over the link itself. Here's a similar one I found by googling. Um, I find those methods (quite old) really annoying, and it's not really nice. Moreover, they were using some kind of package called "Modeler 2D", which no longer exists now, in Mathematica 9.

I think this can be done by using NDSolve. But, as I'm still dumb in solving using Mathematica, I don't understand how exactly should I add the constraint. I tried modifying the toggle mechanism, but I still fail because I should rotate the crank and cause it to slide along the link, so that it moves forwards and backwards.

I personally feel that they've exaggerated a little bit in the simulation. Actually, the the slider should be placed towards the left or else that'd be a quick forward mechanism. But, I just need how the crank slides along the rod. The rest, I can try it as an exercise :D

Answer 1

"But, I just need how the crank slides along the rod. The rest, I can try it as an exercise"

I'll help you out with this detail to get you started. It's really just a case of adding vectors together: The disk moves along a circle inside a circle, so if the outer circle has radius 1 the equation for its movement might be 0.8 {Cos[theta], Sin[theta]}. The rod is connected slightly below the circle, so if the radius of the circle is 1 and it is centered at origo, its position might be {0, -1.2}. Now we want to get a line that goes from the place where the rod is connected through the disk and that is of some specified length. So we get the vector from the origin of the rod to the disk, normalize it and then multiply it with our length, which in this example is 3:

Manipulate[
 Graphics[{
   Circle[{0, 0}, 1],
   Disk[0.8 {Cos[theta], Sin[theta]}, 0.1],
   Line[{
     {0, -1.2},
     {0, -1.2} + 3 Normalize[{0, 1.2} + 0.8 {Cos[theta], Sin[theta]}]
     }]
   }, PlotRange -> {{-2, 2}, {-2, 2}}], {theta, 0, 4 Pi}
 ]

In response to the comment:

I do see the charm in being able to set up a DAE like Michael did in that other answer. It's an absolutely beautiful solution, however you can solve the problem with what I gave above as well. Since now you know the position of the tip of the rod you don't have to start from velocity as Michael did, which means you no longer have a differential equation to solve. Now it's just a normal equation, which should make it easier.

First some definitions that will reduce duplication of code:

rodOrigin = {0, -1.2};
crank[theta_] := 0.8 {Cos[theta], Sin[theta]}
rodTip[theta_, length_] := rodOrigin + length Normalize[crank[theta] - rodOrigin]

I'll try to roughly recreate the animation you posted. Let's first look at what the length of the rod must be to create the starting position that the block has in that animation:

minAngle = theta /. NMinimize[{Normalize[crank[theta] - rodOrigin][[1]], theta > 0}, theta][[2]];
length = Norm[rodTip[minAngle, 2.2] - {0.5, 1.5}]; 

where the constants were computed from the other values that I chose to create the graphics. E.g. remember that the large circle has a radius of one. Now we can solve for the x position of the block as a function of theta:

sol[theta_] := (x /. NSolve[Norm[rodTip[theta, length] - {x, 1.25}] == length, x])[[2]] // Quiet

Putting it all together and writing the graphics:

rodOrigin = {0, -1.2};
crank[theta_] := 0.8 {Cos[theta], Sin[theta]}
rodTip[theta_, length_] := rodOrigin + length Normalize[crank[theta] - rodOrigin]

minAngle = theta /. NMinimize[{Normalize[crank[theta] - rodOrigin][[1]], theta > 0}, theta][[2]];
length = Norm[rodTip[minAngle, 2.2] - {0.5, 1.5}]; 
sol[theta_] := (x /. NSolve[Norm[rodTip[theta, length] - {x, 1.25}] == length, x])[[2]] // Quiet

Manipulate[
 Graphics[{
   Circle[{0, 0}, 1],
   Disk[crank[theta], 0.1],
   Line[{
     rodOrigin,
     rodTip[theta, 2.2]
     }],
   LightGray,
   Rectangle[{sol[theta] - 0.5, 1}, {sol[theta] + 0.5, 1.5}],
   Black,
   Line[{{0, 1.5}, {8, 1.5}}],
   Line[{
     {0, -1.2} + 
      2.2 Normalize[{0, 1.2} + 0.8 {Cos[theta], Sin[theta]}],
     {sol[theta], 1.25}
     }],
   Disk[{sol[theta], 1.25}, 0.1]
   }, PlotRange -> {{-2, 10}, {-2, 3}}], {theta, 0, 4 Pi}
 ]

The corresponding animation looks like this:

To make a DAE out of this and solve it with NDSolve like Michael did can be done by combining the equations used here with the equation that Michael used to make the rod in that problem rotate, I think.