3D Printing in Mathematica

Math 213 - Math with Mathematica
Christopher Hanusa

Overview

In this tutorial, we investigate the issues involved in creating 3D printable models in Mathematica and how to get around them!
At the end of this tutorial, we will create some generative art.

Export-Import

First, we’ll see how easy it is to export a model for 3D Printing.

Exporting is easy.

It is very easy to export from Mathematica into many different file types.  Use the command Export!

?Export

Here’s the 3D zigzag example from the last tutorial:

pointlist={{0,0,0},{1,1,0},{2,0,0},{3,1,0},{4,0,0},{5,1,0},{6,0,0},{7,1,0},{8,0,0}};
zigzag=Graphics3D[Tube[pointlist,.2]]

Because we’ve named the object above, we can just include it in this command here.

Export[NotebookDirectory[]<>"zigzag.png",zigzag]

The extension of the file that you use tells Mathematica which file format you want to export to.  Here we’ve exported to a PNG (image) file.

The NotebookDirectory[] code chooses the folder that our current file is saved in.  The <> (“less-than”-“greater-than”) appends the name of your file to the text string of the current directory.  This helps to keep your files organized.

And then you can see what you’ve exported using Import.

Import[NotebookDirectory[]<>"zigzag.png"]

This imported object is an image.  This means we can’t rotate it or add to it anymore, but we could do some image processing if we wanted to.

Exporting is not easy.

When you want to create a 3D-printable model, you will want to export it to one of the 3D model types, such as STL.

Export[NotebookDirectory[]<>"tubetest.stl",zigzag]

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

Notice anything?

Notice this:

One issue that will come up over and over is that the 3D rendering that Mathematica shows you is not the same as what is export to the STL file.  There are some commands that export well and others that do not export at all!  So as you learn what works and what doesn’t, you will want to export your model to an STL file and re-import it to check that the exported file has the structure you want.

To fix our zigzag structure, we’ll need to add spheres of the same radius as our tube.  Use Map to create them all at once!  Let’s add colors to be able to see the different parts.

spheres=Map[Sphere[#,.2]&,pointlist]
segments=Tube[pointlist,.2]
newZig=Graphics3D[{Blue,segments,Red,spheres}]

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

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

Exporting in color

The STL format does not support color, so we’ll want to use another format (like X3D or WRL) if we want to have a 3D model with some color.

colorZig=Graphics3D[{Red,segments,Blue, spheres}]

Export[NotebookDirectory[]<>"colorZig.x3d",colorZig]

Export[NotebookDirectory[]<>"colorZig.wrl",colorZig]

Unfortunately Mathematica won’t import these formats.

Import[NotebookDirectory[]<>"colorZig.x3d"]
Import[NotebookDirectory[]<>"colorZig.wrl"]

I like to upload my models to Sketchfab.  You can create an account for education using your QC email.
Alternatively, upload your models to Shapeways and view them there.

Comprehension Question

1. Export to STL one of the models you created in Tutorial 7.  Did it export correctly?

2. Use PolyhedronData from the end of Tutorial 7 to create a 3D model of a polyhedron of your choice.  (If you can’t find one you like, may I suggest my favorite polyhedron, the Snub Cube?)  Export it to an STL file.  Upload it to Sketchfab or Shapeways.

PlotPoints helps smooth your model

The PlotPoints option can increase the resolution of your model.  It changes the number of points that Mathematica uses to approximate your model fully.  The setting that you use for PlotPoints will depend on the instance.  Increase the number of points to increase the resolution, but don’t use too many points because it will increase your computation time and make the file you export very large.

Nicer Curves

curve=ParametricPlot3D[{Sin[t],Sin[2t],Sin[3t]},{t,0,2Pi},PlotStyle->Tube[.1],PlotRange->All]

Import[Export[NotebookDirectory[]<>"Curve.stl",curve]]

Make the tube nicer by adding in PlotPoints options into both the ParametricPlot3D function (for the number of points chosen along the curve) and the PlotStyle option (for the number of points chosen on each circular cross-section).

curveHD=ParametricPlot3D[{Sin[t],Sin[2t],Sin[3t]},{t,0,2Pi},PlotStyle->Tube[.1,PlotPoints->50],PlotRange->All,PlotPoints->100]

Import[Export[NotebookDirectory[]<>"Curve.HD.stl",curveHD]]

Nicer Surfaces / RegionPlot3D Objects

block=RegionPlot3D[Sin[x]+Sin[y]>z,{x,0-Pi/2,6Pi-Pi/2},{y,0-Pi/2,6Pi-Pi/2},{z,-3,3}]

Import[Export[NotebookDirectory[]<>"Bumpy.stl",block]]

That’s not nearly as smooth as we would like it, and that is because Mathematica is not sampling many points in the range.  We can specify that Mathematica should choose a certain number of points in each direction using the PlotPoints option.

block2=RegionPlot3D[Sin[x]+Sin[y]>z,{x,0-Pi/2,6Pi-Pi/2},{y,0-Pi/2,6Pi-Pi/2},{z,-3,3},PlotPoints->{100,100,100}]

Import[Export[NotebookDirectory[]<>"Bumpy.HD.stl",block2]]

Comprehension Question

3.  See what happens when you use PlotPoints ONLY as an option for ParametricPlot3D but NOT in the PlotStyle option.
Then see what happens when you use PlotPoints ONLY in the PlotStyle option but NOT as an option for ParametricPlot3D.

4. A fascinating surface you see in multivariable calculus is the function f(x,y)=xy/(x^2+y^2).  This surface is not continuous at (x,y)=(0,0).  Create a block with this upper surface similar to how you did in Tutorial 7.  Adjust the PlotPoints option so that the block has a good enough resolution to see the structure of the discontinuity.

Using ParametricPlot3D to create smooth surfaces

You might wish to include spheres in your model.  If you export a Sphere command, the resolution is not good at large sizes.

sphere=Graphics3D[Sphere[]];

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

Better Sphere

Instead, we can use our knowledge of spherical coordinates to create a better sphere.  A sphere of radius 1 is defined by 
x(u,v)=Cos[u]Sin[v]
y(u,v)=Sin[u]Sin[v]
z(u,v)=            Cos[v]
because x^2+y^2+z^2=(Cos[u]^2+Sin[u]^2)(Sin[v]^2)+(Cos[v]^2)=1.

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

Import[Export[NotebookDirectory[]<>"BetterSphere.stl",bettersphere]]

Even Better Sphere

Combine this with the PlotPoints option to get an even better sphere!  Here PlotPoints has two arguments because there are two variables.

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

Import[Export[NotebookDirectory[]<>"EvenBetterSphere.stl",evenbetter]]

Tor-us! Tor-us!

Similarly, the points on a torus satisfy that the distance (r) to the central circle (of radius R) is constant.  Mathematically, that is:
(x - R cos u)^2 + (y - R sin u)^2 + z^2 = r^2
We can use the following parametrization:
x(u,v)= R Cos[u] + r Cos[u] Cos[v],
y(u,v)= R Sin[u]  + r Sin[u] Cos[v],
z(u,v)=                                 r Sin[v]

Here is the torus whose outer radius is 3 and inner radius is 1.

torus=ParametricPlot3D[{(3+Cos[v]) Cos[u],(3+Cos[v]) Sin[u],Sin[v]},{u,0,2Pi},{v,0,2Pi},PlotStyle->Green,Mesh->None,PlotPoints->30]

Import[Export[NotebookDirectory[]<>"Torus.stl",torus]]

Better torus!

Add in the PlotPoints option to increase the resolution.

btorus=ParametricPlot3D[{(3+Cos[v]) Cos[u],(3+Cos[v]) Sin[u],Sin[v]},{u,0,2Pi},{v,0,2Pi},PlotStyle->Green,Mesh->None,PlotPoints->{80,80}]

Import[Export[NotebookDirectory[]<>"BetterTorus.stl",btorus]]

Comprehension Question

5: Create a model of the surface given by
x(u,v)=Cos[u] (Sin[2v]^2+Sin[v])
y(u,v)=Sin[u] (Sin[2v]^2+Sin[v])
z(u,v)=                  Cos[v]

6.  Create a sphere or torus that is the opposite of smooth --- having extremely POOR resolution.  (Remember to import and export so that you can see the result.)

Challenge Question

7. Create three overlapping tori that form a globe, like this:

8. Create two interlocking tori that loop through one another, like this:.

Learn More

Here is a link to more details about parametrizing surfaces

You may also be interested in learning about ContourPlot3D

{
ContourPlot3D[x^3+y^2-z^2==0,{x,-2,2},{y,-2,2},{z,-2,2}],
ContourPlot3D[x^3+y^2-z^2==0,{x,-2,2},{y,-2,2},{z,-2,2},Extrusion->.1]
}

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[x]},{x,0,2Pi},Axes->False]

We are going to create a surface that slowly changes from the first function to the second, like in this Manipulate command:

Animate[Plot[{t Sin[x]},{x,0,2Pi},Axes->False,PlotRange->{-1,1}],{t,0,1}]

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

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

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

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

I suggest we make t range from 0 to 5 instead so that the surface has a less steep incline.  This is a simple transformation of the t variable---we need to replace t by t/5.

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

We can then extrude it.

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

The extrusion is always 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) Compare the two functions below:

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

Here is a Haversine interpolation between 1 and 5

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

And here is a Haversine interpolation between our two curves.

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

Comprehension Question

9. Let’s create an even more interesting surface!  Make a linear or a haversine interpolation between the two curves f(x)=-cos(3x) and g(x)=sin(5x).  Don’t forget to extrude it and increase PlotPoints to smooth it out.

Challenge Question

10. Create a shape that is an interpolation between a circle and a square.  (Expand to see hints)

Hint 1

You’ll have to use ParametricPlot3D instead of Plot3D.

Hint 2

Create a one-parameter function for the boundary of each both the circle and the square.

Hint 3

For the boundary of the square use a piecewise-defined function.

Hint 4

For the boundary of the circle use {cos(theta),sin(theta)

Algorithmic Art

Algorithmic art is art that is created using algorithms.  You tell the computer what you want to do and the computer generates your art.  Your skills in Mathematica will allow you to create amazing intricate art.

Automating and adding randomness

First create a function that inputs a 3D center of a torus, its outer radius, and its inner radius, like we discussed above.

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]

Now try it out to create two overlapping tori.

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

Now use a Table command to create more overlapping tori:

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

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

Comprehension Question

11. Create a 10 x 10 grid of 100 tori, and export it to an STL file.

Challenge Question

12. Create a function orientedtorus that has an additional parameter that programs the torus to be parallel to the xy-plane, yz-plane, or xz-plane.

Adding Randomness

To incorporate randomness, use RandomInteger or RandomReal. In both cases, the first input gives the range in which to choose the random number; a second input tells how many of such numbers to make, if more than one is desired.

RandomInteger[{-4,4}]
RandomInteger[{1,10},40]

You can even specify that you would like tuples of numbers.  Here we have random (x,y) coordinates with both x and y in the range [0,1].

RandomReal[0.5]
RandomReal[{0,1},{10,2}]

Here we simulate 400 rolls of a die:

rolls=RandomInteger[{1,6},400];
Sort[Tally[rolls]]
Histogram[rolls]

Generative Art

Let’s merge these last two ideas to create generative art, which is algorithmic art including aspects of randomness

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

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

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

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.

Comprehension Question

13. Create a piece of generative art that creates tori with different centers and different radii.

14. Explore further!

Challenge Question Solutions

Solution to Question 7

ParametricPlot3D[{
{(10+Cos[v]) Cos[u],(10+Cos[v]) Sin[u],Sin[v]},
{(10+Cos[v]) Cos[u],Sin[v],(10+Cos[v]) Sin[u]},
{Sin[v],(10+Cos[v]) Cos[u],(10+Cos[v]) Sin[u]}},{u,0,2Pi},{v,0,2Pi},PlotStyle->{Red,Green,Blue},Mesh->None,PlotPoints->30,Boxed->False,Axes->False]

Solution to Question 8

ParametricPlot3D[{{(3+Cos[v]) Cos[u],(3+Cos[v]) Sin[u],Sin[v]},{(3+Cos[v]) Cos[u]+3,Sin[v],(3+Cos[v]) Sin[u]}},{u,0,2Pi},{v,0,2Pi},PlotStyle->{Yellow,Purple},Mesh->None,PlotPoints->{70,70},Boxed->False,Axes->False]