3D Surfaces in Mathematica

Christopher Hanusa (chanusa@qc.cuny.edu)
10 October 2017

Plot / Plot3D

To plot the graph of a function y=f(x), use the Plot command.  This command has the same type of structure as the Table command.

Plot[x^2,{x,-10,10}]

You give the function you want to graph, the variable that is changing, along with its domain.

To plot the graph of a function z=f(x,y), use the Plot3D command.

Plot3D[x^2+y^2,{x,-5,5},{y,-5,5}]

2D and 3D graphics are different types of objects and can not be combined.

Thickening Surfaces

There is a hidden option called Extrusion that allows you to thicken surfaces in order to be able to print them.

bowl=Plot3D[x^2+y^2,{x,-5,5},{y,-5,5},Extrusion->1]

Export[NotebookDirectory[]<>"bowl.stl",bowl]

Import[NotebookDirectory[]<>"bowl.stl"]

Notice that the aspect ratio of Mathematica’s default rendering is not the same as the natural 1-1-1 aspect ratio.  We can fix this with a BoxRatios option

bowl=Plot3D[x^2+y^2,{x,-5,5},{y,-5,5},Extrusion->1,BoxRatios->Automatic]

We can use some simple math to adjust the surface.  Scale it down by a factor of 2 and cut off the box to have height 10.

bowl=Plot3D[1/2(x^2+y^2),{x,-5,5},{y,-5,5},Extrusion->1,BoxRatios->Automatic,PlotRange->{{-5,5},{-5,5},{-1,10}}]

In order to get rid of the gray bits, we need to use the option ClippingStyle.

bowl=Plot3D[1/2(x^2+y^2),{x,-5,5},{y,-5,5},Extrusion->.5,BoxRatios->Automatic,PlotRange->{{-5,5},{-5,5},{-1,10}},ClippingStyle->None]

Export[NotebookDirectory[]<>"betterbowl.stl",bowl]

Import[NotebookDirectory[]<>"betterbowl.stl"]

Interpolation Surfaces

An interpolation between two curves is surface that smoothly varies between the curves.

Consider the two curves f=0 and g=sine as the dependent variable changes between 0 and 2π:

Plot[{0,Sin[y]},{y,0,2Pi},Axes->False]

One simple interpolation is a linear interpolation, where at x=0 we have f and at x=1 we have g, and anywhere along the curve you have a linear combination of those two curves: f(1-x)+g(x).  (Note what happens when you plug in x=0 and x=1.)

Plot[(1-x)1+(x)5,{x,0,1},PlotRange->{{0,1},{0,6}}]

When we do this with functions of y, we get a surface.

Plot3D[(1-x)0+(x) Sin[y],{x,0,1},{y,0,2Pi},BoxRatios->Automatic]

I suggest we make x range from 0 to 5 instead.  We need to replace x by x/5.

Plot3D[(1-x/5)0+(x/5) Sin[y],{x,0,5},{y,0,2Pi},BoxRatios->Automatic]

We can then extrude it.

Plot3D[(1-x/5)0+(x/5) Sin[y],{x,0,5},{y,-5,5},Extrusion->.1,BoxRatios->Automatic]

Note that the extrusion is perpendicular to the tangent plane.

Pro Tip: Instead of a linear interpolation, Smooth out your function by using a Haversine function which has horizontal tangent lines at its endpoints.  (Thanks to Clayton Shonkwiler‏ @shonk)

Plot[Haversine[Pi x],{x,0,1}]

Here is a Haversine interpolation between 1 and 5

Plot[(1-Haversine[Pi x])1+(Haversine[Pi x])5,{x,0,1},PlotRange->{{0,1},{0,6}}]

And here is a Haversine interpolation between our two curves.

Plot3D[(1-Haversine[Pi x/5])0+(Haversine[Pi x/5])Sin[y],{x,0,5},{y,-5,5},Extrusion->.1,PlotPoints->50]

And let’s make an even more interesting surface!

{Plot[-Cos[3y],{y,0,2Pi},Axes->False],Plot[ Sin[5y],{y,0,2Pi},Axes->False]}

Plot3D[(1-Haversine[Pi x/5])(-Cos[3y])+Haversine[Pi x/5] Sin[5y],{x,0,5},{y,0,5},Extrusion->.1,BoxRatios->Automatic]

Export[NotebookDirectory[]<>"Swirls.stl",%]

Import[NotebookDirectory[]<>"Swirls.stl"]

Use PlotPoints!

That’s not nearly as smooth as we would like it, and that is because Mathematica is not sampling many points from the surface.  We can specify that Mathematica should choose a certain number of points along the x-axis and along the y-axis using the PlotPoints option.

Plot3D[(1-Haversine[Pi x/5])(-Cos[3y])+Haversine[Pi x/5] Sin[5y],{x,0,5},{y,0,5},Extrusion->.1,BoxRatios->Automatic,PlotPoints->100]

Export[NotebookDirectory[]<>"SwirlsHD.stl",%]

Import[NotebookDirectory[]<>"SwirlsHD.stl"]

Take Home: Monkey saddle

A saddle point is a point on a surface z=f(x,y) with horizontal tangent plane and where walking in some direction goes uphill and walking in some other direction goes downhill.  The most basic surface with a saddle point is z(x,y)=(x^2)-(y^2)

Plot3D[x^2-y^2,{x,-3,3},{y,-3,3}]

Let’s create a 3D print of the more peculiar Monkey Saddle, the function defined by z(x,y)=(x^3)-(xy^2).

Plot3D[x^3-x*y^2,{x,-3,3},{y,-3,3}]

We’ll have to adjust the z-range and scale it so that it doesn’t have too much height.  We’ll have to use a number of the other options we’ve discussed above.

Here’s the one that is being printed.

Plot3D[1/3(x^3-x*y^2),{x,-3,3},{y,-3,3},PlotRange->{-3,3}, ClippingStyle->None,Extrusion->.2,BoxRatios->Automatic,PlotPoints->100]

Export[NotebookDirectory[]<>"MonkeySaddle.stl",%]

Import["C:\\Users\\Chris\\Dropbox\\Research\\talks\\1710_3DDesign\\MonkeySaddle.stl"]

ParametricPlot3D

Import[Export[NotebookDirectory[]<>"BasicSphere.stl",Graphics3D[Sphere[]]]]

Better Sphere

bettersphere=ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi}]

Export[NotebookDirectory[]<>"BetterSphere.stl",%]

Import[NotebookDirectory[]<>"BetterSphere.stl"]

ParametricPlot3D[{Cos[u]Sin[v],Sin[u]Sin[v],Cos[v]},{v,0,Pi},{u,0,2Pi},PlotPoints->{100,100}]

Export[NotebookDirectory[]<>"EvenBetterSphere.stl",%]

Import[NotebookDirectory[]<>"EvenBetterSphere.stl"]

Tor-us! Tor-us! Tor-us!

outerradius=1;
innerradius=.1;
center={0,0,0};
ParametricPlot3D[{
(outerradius+innerradius Cos[v]) Cos[u],
(outerradius+innerradius Cos[v]) Sin[u],
innerradius Sin[v]}+center,
{u,0,2 Pi},{v,0,2 Pi},Mesh->None,PlotPoints->50]

Automating and adding randomness

torus[center_,outerradius_,innerradius_]:=
ParametricPlot3D[{
(outerradius+innerradius Cos[v]) Cos[u],
(outerradius+innerradius Cos[v]) Sin[u],
innerradius Sin[v]}+center,
{u,0,2 Pi},{v,0,2 Pi},Mesh->None,PlotPoints->50]

Show[
{torus[{0,0,0},1,.1],
torus[{1,0,0},1,.1]},
PlotRange->All]

centers=Table[{i,0,0},{i,0,10}]

Show[Map[torus[#,1,.1]&,centers],
PlotRange->All]

Generative Art

randomcenters=RandomReal[{0,1},{10,3}]

Show[Map[torus[#,1,.1]&,randomcenters],
PlotRange->All]

randomcenters=Table[{RandomReal[{0,10}],RandomReal[{0,10}],0},{i,100}];

Show[Map[torus[#,1,.1]&,randomcenters],
PlotRange->All]

If you want to be able to recreate a particular instance of your work, then you need to save the initializing data.

randomtori=Table[torus[{RandomReal[{0,3}],RandomReal[{0,3}],0},RandomReal[{.7,1}],RandomReal[{.1,.2}]],{i,20}];
Show[randomtori,PlotRange->All]

I’ve written a blog post using this procedure to create some generative jewelry.

Random Colors

coloredtorus[center_,outerradius_,innerradius_,options_]:=
ParametricPlot3D[{
(outerradius+innerradius Cos[v]) Cos[u],
(outerradius+innerradius Cos[v]) Sin[u],
innerradius Sin[v]}+center,
{u,0,2 Pi},{v,0,2 Pi},Mesh->None,PlotPoints->50,PlotStyle->options]

randomtori=Table[coloredtorus[{RandomReal[{0,3}],RandomReal[{0,3}],0},RandomReal[{.7,1}],RandomReal[{.1,.2}],Hue[RandomReal[]]],{i,20}];
Show[randomtori,PlotRange->All]