Message Boards Message Boards

GROUPS:

[GiF] Simulation of a Camshaft

Posted 2 years ago
3828 Views
|
4 Replies
|
8 Total Likes
|

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.

enter image description here

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]

enter image description here

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];

enter image description here

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

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

enter image description here

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}]
]

enter image description here

4 Replies

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

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

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.

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.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract