1
$\begingroup$

The following is my attempt to render a two-bladed marine propeller with 3D graphics. I hope someone can improve on this. The blades don't have a nice appearance. Here's my code so far:

xyPair = {Table[{Sin[u], Sin[2u]}, {u, 0, Pi, 0.1}]};

zValue = Range[0.015625`, 0.5, 0.015625`];

f[xyPair_List, zValue_] := Join[xyPair, {zValue}]

blade1Pts = MapThread[f, {Flatten[xyPair, 1], zValue}];

blade2Pts = 
  RotationMatrix[180 Degree, {0 , 0, 1}] . Transpose[blade1Pts] // Transpose;

prop = ListPlot3D[{blade1Pts, blade2Pts}];

shaft = Graphics3D[Tube[{{0, 0, 0. 6}, {0, 0, 0}}, 0.3]];

Show[shaft, prop,
  Axes->True,AxesLabel->{"x","y","z"}, PlotRange->All,
  ImageSize->500, ViewPoint->Front]

Propeller

Any help would be appreciated.

PS. I'm using Mathematica 8.0.4 and Windows 7 Pro.

$\endgroup$
  • $\begingroup$ What do you want them to look like? Here's something to get you started: add MeshStyle -> None, PlotStyle -> Blue to the prop. Look up ListPlot3D (place the cursor on the command and press F1) and check out the other options for styping it as you wish. $\endgroup$ – bill s May 29 '17 at 1:50
  • $\begingroup$ @BillS: To more accurately describe my problem, please plot this: ListPlot3D[blade1Pts,PlotStyle->Thickness[0.02],Mesh->None,MaxPlotPoints->100,MaxPlotPoints->25,Axes->True,AxesLabel->{"x","y","z"}] . Notice the wrinkles on the blade's surface. I'd like a smoother surface. Thanks, Bill W. $\endgroup$ – Bill W. May 29 '17 at 4:39
  • 2
    $\begingroup$ Do you want to keep the specific shape you've shown in the image, with the "crease" across the middle, or do you just want to draw any smooth propeller-like surface? $\endgroup$ – Rahul May 29 '17 at 8:10
  • $\begingroup$ @Rahul: On the plot above, the crease is what I was trying to eliminate. $\endgroup$ – Bill W. May 29 '17 at 17:56
  • $\begingroup$ @ m_Goldberg: I used your Polygon code, as Triangle was unknown to M804. Thanks. $\endgroup$ – Bill W. May 29 '17 at 18:00
3
$\begingroup$

This answer really only provides what might be the starting point for a full solution.

Marine propellers are often called "screws", which should remind us the were at originally based on helices. So we can make something that looks like an early Marine propeller as follows.

interuptedHelix = 
  With[{turns = 1, ht = 1},
    Module[{pitch, umax},
     pitch = ht/turns;
     umax = N[2 π] turns Sqrt[1 + (pitch/N[4 π])^2];
     Show[
       ParametricPlot3D[{Cos[u], Sin[ u], pitch (u - umax/2)/N[2 π]}, 
         {u, 0, umax/4 }],
       ParametricPlot3D[{Cos[u], Sin[ u], pitch (u - umax/2)/N[2 π]}, 
         {u, umax/2, 3 umax /4}],
       BoxRatios -> {1, 1, 1/2},
       PlotRange -> All]]]

helix

Now let's use these parametric curves to build a two-bladed propeller out triangles which have one point at the origin and two points taken from successive points on the curves.

bladeEdgePts = Cases[interuptedHelix, Line[p : {{_, _, _} ..}] -> p, ∞];
blades =
  Map[
    Triangle[{{0, 0, 0}, #[[1]], #[[2]]}] &, 
    Partition[#, 2, 1] & /@ bladeEdgePts, 
    {2}];
hub = Tube[{{0, 0, -.3}, {0, 0, .3}}, 0.3];

Graphics3D[{EdgeForm[], blades, hub},
  Axes -> True, AxesLabel -> {"x", "y", "z"}, ImageSize -> 500]

prop

However, real marine propellers are not surfaces. They have a cross-section rather like an airfoil. Also, of course, (except for some very early, slow turning ones) the blades do not have sharp, turbulence-producing corners. Including these additional features will, I think, make a more realistic solution to your problem rather difficult.

Note: In Mathematica 8.0.4 you will probably need

blades =
  Map[
    Polygon[{{0, 0, 0}, #[[1]], #[[2]], {0, 0, 0}}] &, 
    Partition[#, 2, 1] & /@ bladeEdgePts, 
    {2}];

I don't think Triangle goes back that far.

$\endgroup$
3
$\begingroup$

Here's a 3 blade Propeller:

prop = ParametricPlot3D[{u Cos[v], u Sin[v], 
Im[(u Exp[I v]^3)^(1/3)]}, {u, 0, 2}, {v, 0, 2 Pi}, Mesh -> None, 
PlotStyle -> Thickness[0.03],
AxesLabel -> {"X", "Y", "Z"}, ImageSize -> 500, 
Background -> LightBlue, ViewPoint -> Top];

shaft = Graphics3D[{Yellow, Tube[{{0, 0, 0.7}, {0, 0, -0.7}}, 0.4]}];

pic = Show[prop, shaft]

Show[pic, ViewPoint -> Front]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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