10
$\begingroup$

I recently discovered a very beautiful Steiner surface which is owned by the Whitney Museum of American Art in New York City. It was created in 1970 by Ruth Landshoff Vollmer (1903 - 1982), a German-born conceptual artist who was forced to emigrate to the United States in 1935.

enter image description here

Ruth Vollmer, Steiner Surface, 1970, (26.7 × 30.2 × 29.5 cm)

Reproduction attempt

steiner = {Cos[u] Sin[u] Sin[v]^2, Cos[u] Cos[v] Sin[v], Sin[u] Cos[v] Sin[v]};

hull =
  ParametricPlot3D[steiner, {u, 0, 2 Pi}, {v, 0, Pi/2},
   Lighting -> "Accent",
   Mesh -> 0,
   PlotPoints -> 32,
   PlotStyle -> MaterialShading[{"Glazed", RGBColor[0.75, 0.75, 0.75, 0.25]}]];

mesh =
  ParametricPlot3D[steiner, {u, 0, 2 Pi}, {v, 0, Pi/2},
   ColorFunction -> (Gray &),
   Mesh -> {3, 2},
   MeshStyle -> Tube[0.0075],
   PlotPoints -> 64,
   PlotStyle -> None];

Framed @ Show[
  hull,
  mesh,
  Axes -> False,
  Boxed -> False,
  ViewAngle -> 40 Degree,
  ViewPoint -> {1, 1, 0}]

enter image description here

The above hull is transparent and shows some reflections, but it is also flat and not very glass-like. My next step was to add a floor and two walls as well as directional lights to create a certain depth:

walls =
  Table[
   Graphics3D[{GrayLevel[0.9],
     GeometricTransformation[
      Polygon[{{-1, -1, -0.5}, {-1, 1, -0.5}, {1, 1, -0.5}, {1, -1, -0.5}}],
      {RotationMatrix[Pi/2, w], {0, 0, 0}}]}],
   {w, {{-1, 0, 0}, {0, 1, 0}, {0, 0, 1}}}];

Framed @ Show[
  hull,
  mesh,
  walls,
  Axes -> False,
  Boxed -> False,
  Lighting -> {
    {"Directional", Orange, ImageScaled[{1, -0.5, 1}]},
    {"Directional", Gray, ImageScaled[{-1, -0.5, 1}]},
    {"Directional", Gray, ImageScaled[{0, 1, 1}]},
    {"Ambient", GrayLevel[0.2]}},
  ViewAngle -> 40 Degree,
  ViewPoint -> {1, 1, 0}]

enter image description here

A certain improvement, but still far from showing a "glassy volume".

Question

I am aware of the fact that Mathematica has very limited ray-tracing capabilities. On the other hand I think that my above reproduction attempt could be significantly improved. What are your ideas to produce a volumetric acrylic surface?

$\endgroup$

1 Answer 1

6
$\begingroup$

I think it is more important to have correct ribs inside the figure than "correct" lighting because Mesh -> {3, 2} does not resembles the ribs well.

I believe I correctly found the six equation of the ribs. They are formed by six ellipse-like planar curves.

steiner = {Cos[u] Sin[u] Sin[v]^2, Cos[u] Cos[v] Sin[v], 
   Sin[u] Cos[v] Sin[v]};

ribs = Join[
   Insert[{Sin[t]/(2 Sqrt[2]), Sin[t]/(2 Sqrt[2])}, 
      1/2 Cos[t/2]^2, #] & /@ Range[3], 
   Insert[{-(Sin[t]/(2 Sqrt[2])), Sin[t]/(
       2 Sqrt[2])}, -(1/2) Cos[t/2]^2, #] & /@ Range[3]];

hull = ParametricPlot3D[steiner, {u, 0, 2 Pi}, {v, 0, Pi/2}, 
   Lighting -> "Accent", Mesh -> 0, PlotPoints -> 32, 
   PlotStyle -> Opacity[0.5]];
pribs = ParametricPlot3D[ribs, {t, 0, 2 Pi}, PlotStyle -> Gray];

Show[hull, pribs, Boxed -> False, Axes -> False]

Steiner surface

Or perhaps better to have the curves (ribs) filled.

Show[hull, 
 Graphics3D[{Gray, Opacity[0.7], 
   Polygon[Table[#, {t, 0, 2 Pi, 2 Pi/100.}]] & /@ ribs}, 
  Lighting -> "Accent"], Boxed -> False, Axes -> False]

animated Steiner surface

$\endgroup$

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