[GiF] Simulation of a Camshaft

Staff Picks
, , , , ,
1

I helped to answer a camshaft question and thought I’d share the code here too. A camshaft is a shaft to which a cam is fastened or of which a cam forms an integral part. The goal is to make the valve tap the cam throughout the course and produce an image similar to the one below.

Cam-disc-2_frontview_animated.gif

Here is the cam provided by the OP.

r1 = 15; r2 = 8; c = 50; ? = ArcSin[(r1 - r2)/c] // N;

l1 = (2 ? + ?) r1;
l2 = (? - 2 ?) r2;
l3 = 2 c Cos[?];
L = 2 c Cos[?] + (2 ? + ?) r1 + (? - 
      2 ?) r2;

cam = {Circle[{0, 0}, r1, {Pi/2 - ?, ((3*Pi))/2 + ?}], 
   Circle[{c, 0}, r2, {Pi/2 - ?, -(Pi/2) + ?}], 
   Line[{{Cos[Pi/2 - ?]*r1, 
      Sin[Pi/2 - ?]*r1}, {Cos[Pi/2 - ?]*r2 + c, 
      Sin[Pi/2 - ?]*r2}}], 
   Line[{{Cos[((3*Pi))/2 + ?]*r1, 
      Sin[((3*Pi))/2 + ?]*r1}, {Cos[-(Pi/2) + ?]*r2 + c,
       Sin[-(Pi/2) + ?]*r2}}], PointSize[0.03], Point[{0, 0}]};

g = Graphics[cam];

rValve = 4;
posição = 15 + rValve;
valve = Graphics[
   {
    Red,
    Thickness[0.008],
    Circle[{0, posição}, rValve, {0, -Pi}],
    Line[{{-rValve, posição}, {-rValve, posição + 20}}],
    Line[{{rValve, posição}, {rValve, posição + 20}}],
    Line[{{-rValve, posição + 20}, {rValve, posição + 20}}]
    }
   ];

Show[g, valve]

CNwra.jpg
CNwra.jpg360×270 5 KB

To solve this, RegionDistance can be useful here.

cambd = RegionUnion[
  Circle[{0, 0}, r1, {Pi/2 - ?, ((3*Pi))/2 + ?}], 
  Circle[{c, 0}, r2, {-(Pi/2) + ?, Pi/2 - ?}], 
  Line[{{Cos[Pi/2 - ?]*r1, Sin[Pi/2 - ?]*r1}, {Cos[Pi/2 - ?]*r2 + c, Sin[Pi/2 - ?]*r2}}], 
  Line[{{Cos[((3*Pi))/2 + ?]*r1, Sin[((3*Pi))/2 + ?]*r1}, {Cos[-(Pi/2) + ?]*r2 + c, Sin[-(Pi/2) + ?]*r2}}]
];

posiçãoVal[?_?NumericQ] :=
  With[{cambd? = TransformedRegion[cambd, RotationTransform[?]]},
	 y /. Quiet[FindRoot[RegionDistance[cambd?, {0, y}] == rValve, {y, 60}]]
  ]

Table[posiçãoVal[?], {?, 0, 2? - ?/6, ?/6}]

{19., 20.4853, 30.8282, 62., 30.8282, 20.4853, 19., 19., 19., 19., 19., 19.}

frames = Table[
  Graphics[{
    GeometricTransformation[cam, RotationMatrix[?]],
    posição = posiçãoVal[?];
    {Red, Thickness[0.008], 
     Circle[{0, posição}, rValve = 4, {-Pi, 0}], 
     Line[{{-rValve, posição}, {-rValve, posição + 20}}], 
     Line[{{rValve, posição}, {rValve, posição + 20}}], 
     Line[{{-rValve, posição + 20}, {rValve, posição + 20}}]}
   },
   PlotRange -> {{-59, 59}, {-59, 83}}
  ],
  {?, 0, 2? - ?/12, ?/12}
];

Export["Desktop/cam.gif", frames];

dsrWm.gif

Here’s a plot of the valve height relative to the cam center point:

Plot[posiçãoVal[?], {?, 0, 2?}, PlotRange -> {15, 66}, PerformanceGoal -> "Speed"]

Ol6p7.png
Ol6p7.png370×249 9.99 KB

In polar coordinates, we can see we’re indeed tracing the isocurve of distance 4 from the cam:

Show[
  PolarPlot[posiçãoVal[?+?/2], {?, 0, 2?}, PolarAxes -> {True, False}, PolarTicks -> {"Degrees", Automatic}, PerformanceGoal -> "Speed"],
  Graphics[{Red, Thick, cam}]
]

uYniT.png
uYniT.png347×338 27.8 KB

7 Likes
2

Thanks for sharing! Might be useful at some point! Very courageous of using “çã” in a function name!

3

Ha, thanks! I just copied the variable name OP used. It looks like it translates to position in Portuguese.

4

Thanks for the post. Just a quick note for Wolfram beginners, like me, the code listed here will not run as a standalone simulation. First follow the link to Stack Exchange to find the proceeding code blocks then use the code above to generate the animation. I let this code run for about 10 minutes at 98% CPU and 750 MB RAM before I started troubleshooting and actually read the code …

Edit: Thanks for the update below. I should have clarified that the 10 minutes of waiting was before I grabbed the needed code from Stack Exchange. Basically I had the kernel trying to solve the function without defining any of the variables. After getting the full code, as you say, it was quick to run.

5

Sorry about that! I’ve added the code from Stack Exchange to this post.

As for the speed and memory consumption, generating the plot takes me about 94 seconds and uses about 12MB of RAM:

AbsoluteTiming[MaxMemoryUsed[Plot[posiçãoVal[?], {?, 0, 2?}, PlotRange -> {15, 66}]]]

{94.1281, 11679216}

Adding the option PerformanceGoal -> "Speed" improves things in a noticeable way and does not seem to make the plots appear any different. I’ve gone ahead and added that option in the post. On my machine, it’s now about 18 seconds and 3MB of RAM:

AbsoluteTiming[MaxMemoryUsed[Plot[posiçãoVal[?], {?, 0, 2?}, PlotRange -> {15, 66}, 
  PerformanceGoal -> "Speed"]]]

{18.4705, 2907720}

Let me know if you’re still having issues.

1 Like