Enneper Sculpture

Sculpture for 3D printing

Feb 11, 2001

Here is the source notebook for a 3D sculpture I really like.

It is very organic..

it is similar to a plant which would start as a disk, but where the outside edge would grow faster than the radius…

NormalizeVector[u_] := If[ u.u > 0, u/Sqrt[u.u], 0];

<< Default3D`[/wlcode]

[wlcode]G1[r_, \[CapitalTheta]_] := {
   r Cos[\[CapitalTheta]] - 1/15 r^5 Cos[5 \[CapitalTheta]],
   r Sin[\[CapitalTheta]] + 1/15 r^5 Sin[5 \[CapitalTheta]],
   2/3 r^3 Cos[3 \[CapitalTheta]] + 0.5
   };[/wlcode]

[wlcode]G2[r_, \[CapitalTheta]_] := {
   r Cos[\[CapitalTheta]] - 1/15 r^5 Cos[5 (\[CapitalTheta] + Pi)],
   r Sin[\[CapitalTheta]] + 1/15 r^5 Sin[5 (\[CapitalTheta] + Pi)],
   2/3 r^3 Cos[3 \[CapitalTheta]]
   };[/wlcode]

[wlcode]r = 1.3;
Do[g1 = ParametricPlot[  {
     r Cos[\[CapitalTheta]] - 
      1/5 r^5 (Cos[5 \[CapitalTheta]] - Cos[n \[CapitalTheta]]/10),
     r Sin[\[CapitalTheta]] + 
      1/5 r^5 ( Sin[5 \[CapitalTheta]] - Sin[n \[CapitalTheta]]/10)
     }, {\[CapitalTheta], 0, 2 Pi}, DisplayFunction -> Identity, 
    PlotPoints -> 70];
  g2 = ParametricPlot[  {
     r Cos[Θ] – 
      1/5 r^5 (Cos[5 Θ] + Cos[n Θ]/10),
     r Sin[Θ] + 
      1/5 r^5 ( Sin[5 Θ] + Sin[n Θ]/10)
     }, {Θ, 0, 2 Pi}, DisplayFunction -> Identity, 
    PlotPoints -> 70, PlotStyle -> RGBColor[1, 0, 0]];
  Show[ g1, g2, DisplayFunction -> $DisplayFunction, 
   AspectRatio -> Automatic, PlotLabel -> ("n=" <> ToString[n])];
  , {n, 2, 2}];
Clear[r];

pairList[l_] := Transpose[ { Drop[l, -1], Rest[l]}];

MaxRValue = 1.3;
ThetaPoints = 28;
Rpoints = 8;
MinTheta = (1/3 + 1/6) Pi;
MaxTheta = MinTheta + 1 /3 Pi;
edgeSize = 1/5;
edgePower = 1;
centerThickness = .1;

f1[r_, Θ_] := {
   r Cos[Θ] – 1/5 r^5 (Cos[5 Θ]) + 
    1/5 r (Cos[2 Θ] edgeSize),
   r Sin[Θ] + 1/5 r^5 (Sin[5 Θ]) – 
    1/5 r ( Sin[2 Θ] edgeSize),
   2/3 r^3 Cos[3 Θ] – 
    centerThickness/2 (MaxRValue – r)^edgePower
   };
f2[r_, Θ_] := {
   r Cos[Θ] – 1/5 r^5 (Cos[5 Θ]) – 
    1/5 r (Cos[2 Θ] edgeSize),
   r Sin[Θ] + 1/5 r^5 (Sin[5 Θ]) + 
    1/5 r ( Sin[2 Θ] edgeSize),
   2/3 r^3 Cos[3 Θ] + 
    centerThickness/2 (MaxRValue – r)^edgePower
   };
g2 = ParametricPlot3D[
   f2[r, Θ], {Θ, MinTheta, MaxTheta}, {r, 
    0, MaxRValue}, PlotPoints -> {ThetaPoints, Rpoints}, 
   ViewPoint -> {-2, 0, 0}, Boxed -> False, ViewVertical -> {0, 0, 1},
    PlotRange -> All, DisplayFunction -> Identity, 
   Compiled -> False];
g1 = ParametricPlot3D[
   f1[r, Θ], {Θ, MinTheta, MaxTheta}, {r, 
    0, 1.3}, PlotPoints -> {ThetaPoints, Rpoints}, 
   ViewPoint -> {-2, 0, 0}, Boxed -> False, ViewVertical -> {0, 0, 1},
    PlotRange -> All, DisplayFunction -> Identity, 
   Compiled -> False];
allborder1 = 
  Table[f1[MaxRValue, Θ], {Θ, MinTheta, 
    MaxTheta, (MaxTheta – MinTheta)/(ThetaPoints – 1)}];
allborder2 = 
  Table[f2[MaxRValue, Θ], {Θ, MinTheta, 
    MaxTheta, (MaxTheta – MinTheta)/(ThetaPoints – 1)}];
edges = Flatten[#, 1] & /@ 
   Transpose[{pairList[allborder1], 
     Reverse /@ pairList[allborder2]}];
If[{MinTheta, MaxTheta} != {0, 2 Pi},
  allborder1 = 
   Table[f1[r, MinTheta], {r, 0, MaxRValue, 
     MaxRValue/(Rpoints – 1)}];
  allborder2 = 
   Table[f2[r, MinTheta], {r, 0, MaxRValue, 
     MaxRValue/(Rpoints – 1)}];
  edges = 
   Join[edges, 
    Flatten[#, 1] & /@ 
     Transpose[{pairList[allborder1], 
       Reverse /@ pairList[allborder2]}]];
  allborder1 = 
   Table[f1[r, MaxTheta], {r, 0, MaxRValue, 
     MaxRValue/(Rpoints – 1)}];
  allborder2 = 
   Table[f2[r, MaxTheta], {r, 0, MaxRValue, 
     MaxRValue/(Rpoints – 1)}];
  edges = 
   Join[edges, 
    Flatten[#, 1] & /@ 
     Transpose[{pairList[allborder1], 
       Reverse /@ pairList[allborder2]}]];
  ];

Show[g1, g2, Graphics3D[Polygon /@ edges], 
  DisplayFunction -> $DisplayFunction, PlotRange -> {All, All, All}];

<< RealTime3D`[/wlcode]

[wlcode]Show[g1, g2, Graphics3D[Polygon /@ edges], 
  DisplayFunction -> $DisplayFunction, Mesh -> False];

The 3D printed result on Zcorp printer