16
$\begingroup$

Sliceforms are models made from intersecting sets of planes which slot together to generate intersecting three-dimensional surfaces. Here are some of them made by Nadja Vohradsky for the

university of oxford mathematics-online-exhibition 2020

enter image description here

Sliceforms sit happily on the border between art and mathematics, as we can see in this graphic by Victor Vasarely:

enter image description here

My request

I think it is very difficult to reproduce some of the three-dimensional forms (certainly too difficult for me). I would therefore also accept two-dimensional, Vasarely-like solutions.

$\endgroup$
2
  • $\begingroup$ The 2D case is too difficult for me. I would like to know how to product it. I add graphics to the tags. $\endgroup$
    – cvgmt
    Jan 28 at 23:17
  • $\begingroup$ No problem - the main question concerns the 3D case $\endgroup$
    – eldo
    Jan 29 at 0:21

4 Answers 4

12
$\begingroup$

Turns out SliceContourPlot3D provides almost everything we need:

ClearAll[sliceForm]

SetAttributes[sliceForm, HoldAll]

sliceForm[reg_, f_ : x + y, nx_ : 7, ny_ : 7, opts : OptionsPattern[]] := 
 SliceContourPlot3D[f, 
   {{"XStackedPlanes", nx}, {"YStackedPlanes", ny}}, 
   {x, y, z} ∈ reg, 
   opts, 
   PlotTheme -> "ThickSurface",
   Axes -> False, ContourStyle -> None, 
   Boxed -> False, BoundaryStyle -> None,  
   ImageSize -> Medium, Background -> Black, SphericalRegion -> True]



sliceForm[reg_, opts : OptionsPattern[]] := sliceForm[reg, x + y, 7, 7, opts]

Examples:

Row[{sliceForm[#], 
  sliceForm[#, x + y, 10, 10, ColorFunction -> "Rainbow"], 
  sliceForm[#, x + y, 10, 10, PlotTheme -> None]}, Spacer[5]]& @ Ball[]

enter image description here

Replace Ball[] with Cube[] to get

enter image description here

Use Cone[] to get

enter image description here

Use Cylinder[] to get

enter image description here

Use Pyramid[{{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}, {0, 0, 1}}] to get

enter image description here

Define a solid region as

reg = ImplicitRegion[{x^2 + y^2 <= 1 && z <= Sin[x  y]},
   {{x, -1, 1}, {y, -1, 1}, {z, -1, 1}}];

enter image description here

Row[{sliceForm[#], 
    sliceForm[#, x + y, 10, 10, ColorFunction -> "Rainbow"], 
    sliceForm[#, x + y, 10, 10, PlotTheme -> None]}, Spacer[5]] & @ reg

enter image description here

Row[{sliceForm[#, BoxRatios -> Automatic], 
    sliceForm[#, x^2 + y^2, 10, 10, ColorFunction -> "Rainbow", 
      BoxRatios -> Automatic], 
    sliceForm[#, x^2 + y^2, 10, 10, PlotTheme -> None, 
      BoxRatios -> Automatic]}, Spacer[5]] & @ FilledTorus[]

enter image description here

$\endgroup$
19
$\begingroup$
plot = Plot3D[Sin[x*y], {x, y} ∈ Disk[], Boxed -> False, 
   Axes -> False, PlotStyle -> None, BoundaryStyle -> None];
Graphics3D[
 Cases[Normal@plot, 
  Line[pts_] :> 
   Polygon[Join[{{pts[[1, 1]], pts[[1, 2]], -1}}, 
     pts, {{pts[[-1, 1]], pts[[-1, 2]], -1}}]], -1], Boxed -> False]

enter image description here

  • Apple
Clear[plot];
plot = ParametricPlot3D[{(1 + Cos[v]) Cos[u] + .1 Cos[5 u], (1 + 
       Cos[v]) Sin[u], 
    1.5 Sin[v] + .5 Cos[v] - .2 Log[1 - v/π]}, {u, 0, 
    2 π}, {v, -π, π}, MeshFunctions -> {#1 &, #2 &}, 
   Mesh -> 15, Boxed -> False, AspectRatio -> Automatic, 
   Axes -> False, PlotStyle -> None];
Graphics3D[{Green, 
  Cases[Normal@plot, Line[pts_] :> Polygon[pts], -1]}, Boxed -> False]

enter image description here

  • Stanford Bunny
Clear[reg];
reg = ResourceData["Stanford Bunny"];
plot = RegionPlot3D[reg, Mesh -> 15, MeshFunctions -> {#1 &, #2 &}, 
   PlotStyle -> None, BoundaryStyle -> None, Boxed -> False];
Graphics3D[{Green, 
  Cases[Normal@plot, Line[pts_] :> Polygon[pts], -1]}, Boxed -> False]

enter image description here

  • For the thick surface.(Too slow)
Clear["Global`*"];
reg = ResourceData["Stanford Bunny"];
plot = RegionPlot3D[reg, Mesh -> 15, MeshFunctions -> {#1 &, #2 &}, 
   PlotStyle -> None, BoundaryStyle -> None, Boxed -> False];
Show[Cases[Normal@plot, 
  Line[pts_] :> 
   RegionPlot3D[Polygon[pts], {"Extrusion" -> .002}, 
    BoundaryStyle -> None, ColorFunction -> Hue], -1], Boxed -> False]

enter image description here

Clear[g, image];
g = Graphics[
  Table[{FaceForm[Darker@Red], Rectangle[{i, j}, {i + 1, j + 1}], 
    FaceForm[], 
    Rectangle[{i, j} + {.1, .1}, {i + 1, j + 1} - {.1, .1}], 
    FaceForm[Black], 
    Triangle[{{i, j} + {.1, .1}, {i, j} + {.1, .9}, {i, 
        j} + {.9, .9}}], FaceForm[White], 
    Triangle[{{i, j} + {.1, .1}, {i, j} + {.9, .1}, {i, 
        j} + {.9, .9}}]}, {i, 1, 20}, {j, 1, 20}]]
image = Image[g];

enter image description here

center = {0.5, 0.5};
radius = .5; scale = 2.5; twist = 1;
transformationFunction = 
  Function[{pt}, 
   Module[{dist, angle, newPt}, dist = EuclideanDistance[pt, center];
    If[dist <= radius, angle = twist  (1 - dist/radius);
     newPt = 
      pt + scale  (pt - center)  (1 - dist/radius)^2  {Cos[angle], 
         Sin[angle]}, newPt = pt];
    newPt]];
distortedImage = 
 ImageForwardTransformation[image, transformationFunction]

enter image description here

$\endgroup$
1
  • $\begingroup$ Thank you, cvgmt, your reproduction is really astonishing in its faithfulness to Vasarely's work. $\endgroup$
    – eldo
    Jan 29 at 9:27
11
$\begingroup$

An attempt, where I have hollowed out the ball. This can save material.

hx = Hyperplane[{1, 0, 0}, #] & /@ Range[-5, 5, 2];
hy = Hyperplane[{0, 1, 0}, #] & /@ Range[-5, 5, 2];
hz = Hyperplane[{0, 0, 1}, #] & /@ Range[-5, 5, 2];

RegionDifference[
  RegionIntersection[Ball[{0, 0, 0}, 10], #] & /@ hx~Join~hy~Join~hz //
    RegionUnion,
  Ball[{0, 0, 0}, 8]
  ] // DiscretizeRegion

enter image description here


RegionIntersection[Ellipsoid[{0, 0, 0}, {4, 4, 8}], #] & /@ 
   hx~Join~hy~Join~hz // RegionUnion // Region

enter image description here

$\endgroup$
10
$\begingroup$

We use CSGRegion to construct a CSGRegion object using scaled/translated/possibly-rotated versions of Cube[] and use it to slice 3D solids:

ClearAll[csgSlicer]

Options[csgSlicer] = 
   {"BladeThickness" -> .025,
    "BladePositions" -> Most[Rest@Range[-1, 1, .25]], 
    "RotationAngle" -> 0,
    "Length" -> 2, 
    "Width" -> 2};

csgSlicer[OptionsPattern[]] := Module[{$tr, $dir, $ra, $bt, $bp, $l, $w, $t},
  {$ra, $bt, $bp, $l, $w} = OptionValue @ 
    {"RotationAngle", "BladeThickness", "BladePositions", "Length", "Width"};
  CSGRegion["Union", 
   Join[Map[Rotate[Translate[Scale[Cube[], {$bt, $l, $w}], {#, 0, 0}], 
          $ra, {0, 1, 0}] &] @ $bp, 
        Map[Rotate[Translate[Scale[Cube[], {$l, $bt, $w}], {0, #, 0}], 
          $ra, {1, 0, 0}] &] @ $bp]]]

Examples:

csgSlicer[]

enter image description here

csgSlicer["BladeThickness" -> .1]

enter image description here

csgSlicer["RotationAngle" -> 45  Degree, 
 BaseStyle -> {EdgeForm[], Specularity[White, 20], Red}]

enter image description here

Using csgSlicer to slice 3D solids:

{ball, cube, cone, cylinder, dodecahedron, pyramid} = 
 {Ball[], Cube[2], Cone[], Cylinder[], Dodecahedron[], 
  Pyramid[{{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}, {0, 0, 1}}]};

Grid[Partition[#, 3] & @
  Map[CSGRegion["Intersection", {ToExpression @ #, csgSlicer[]}, 
      ImageSize -> Medium, PlotLabel -> Style[#, White], 
      Lighting -> "Neutral", Background -> Black, 
      BaseStyle -> {EdgeForm[None], Specularity[White, 20], Orange}] &] @ 
 {"cube", "ball", "cylinder", "cone", "pyramid", "dodecahedron"}, 
 Dividers -> All]

enter image description here

Replace csgSlicer[] with csgSlicer["BladeThickness" -> .05, "RotationAngle" -> 60 Degree] to get

enter image description here

Replace csgSlicer[] with

csgSlicer["BladeThickness" -> .01, 
 "BladePositions" -> (Join[#, -#] &@Most@Rest[Subdivide[-1, 1, 9]])]

to get

enter image description here

Replace "Intersection" with "Difference" and use csgSlicer["BladeThickness" -> .1, "Length" -> 10, "Width" -> 10] to get

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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