Multivariable Calculus Computer Algebra Project 2012

Oliver knill, Harvard Summer School, knill@math.harvard.edu, Maths21a, Summer 2012

In this  Mathematica 8 project, we produce a printable 3D object. We provide some examples. You can see that in each case a so called “STL” file is exported. This is the format which a 3D printer can understand.  The assignment at the very end. The project is due on Friday August 3th electronically by email. Please check the following

   1. Make sure that the object has the right size. A box of size [-0.5,0.5] should be ok to have a 10-20 dollar object. 
   2. The object has to be closed and no holes. No thin walls also. 
   3. Export the STL file, then import it again like in the first example to see how it displays.

Content in a mathematica file is organized as cells. To evaluate, grab the bracket to the right, holding down the shift key and hit return.

General  objects

M=11; r=0.5;Clear[f];
A1=Table[r {Cos[2Pi i/M],Sin[2Pi i/M],0},{i,M}]; f[P_]:=0.8*P+{0,0,1}; A2=RotateRight[Map[f,A1],3];
A3=Table[{A1[[i]],A1[[Mod[i,M]+1]],A2[[Mod[i,M]+1]],A2[[i]]},{i,M}];
S=Show[Graphics3D[ {Polygon[A1],Polygon[A2],Map[Polygon,A3]}],Axes->True];
Export["1.stl",S,"STL"]
Import["1.stl"]

(Added Aug 1:) Here is a simpler example called “Kung-Fu”

A1={Yellow,Polygon[{{0,0,0},{0,3,0},{3,3,0},{3,0,0}}]};
A2={Blue,Cylinder[{{2,1,0},{0,3,3}},0.1]};
A3={Red,Sphere[{2,2,2.5},0.6]};
A4={Orange,Cuboid[{1,1,1},{2,2,2}]};
A5={Yellow,Sphere[{0,3,3},0.2]};
A6={Yellow,Sphere[{2,1,0},0.2]};
S=Show[Graphics3D[Scale[{A1,A2,A3,A4,A5,A6},0.2]],ViewPoint->{0.51,3.30,0.494}]

Polytopes

Get["PolyhedronOperations`"];

g=First[Geodesate[PolyhedronData["Dodecahedron"],1]];
v=N[0.5*g[[1]]];f=g[[2,1]];vv=Union[Flatten[f]];w=Table[v[[vv[[k]]]],{k,Length[vv]}];
S1=Graphics3D[Table[Polygon[{v[[f[[k,1]]]],v[[f[[k,2]]]],v[[f[[k,3]]]]}],{k,Length[f]}]];
S2=Graphics3D[Table[Sphere[(1-0.03)w[[k]],0.06],{k,Length[w]}]];S=Show[{S1,S2},Axes->True]

Contour plots

S=ContourPlot3D[ x^2+y^2+z^2+Sin[5 x y z]==0.1,{x,-0.5,0.5},{y,-0.5,0.5},{z,-0.5,0.5}]

Parametrized surfaces

S=ParametricPlot3D[ (1.2+Cos[2t] Sin[3 s]) {Cos[t] Sin[s],Sin[t]Sin[s],Cos[s]}/2,{t,0,2Pi},{s,0,Pi}]

Knots

S=Show[KnotData[{7,3}]]

Spherical plots

S=SphericalPlot3D[0.1(1.4+Cos[4t]) (1+Sin[s]),{s,0,Pi},{t,0,2Pi},PlotRange->All,PlotPoints->40]

Built in objects

S=ListSurfacePlot3D[ExampleData[{"Geometry3D","Horse"},"VertexData"],MaxPlotPoints->40]
Export["7.stl",S,"STL"]

From the web

A=Import["http://www.georgehart.com/rp/sierpinski5-george-hart.stl"];
B=Import["http://www.georgehart.com/rp/Goldberg-8-3-george-hart.stl"];Show[Graphics3D[{Scale[A[[1]],2],Translate[Scale[B[[1]],0.6],{1,1,3}]}],Boxed->False]

Assignment

Be creative. If you use inspiration beyond these templates, give credit. Use the above templates to do the following: 

1) (2 points) A printable parametric surface of your choice.
2) (2 points) A printable spherical plot of your choice.
3) (2 points) A printable level surface of your choice.
4) (2 points) A printable polyhedron of your choice
5) (2 points) A printable object of your choice. 

Submit your notebook after removing all the graphics in the above menu Cell -> Delete All Output.

Oliver Knill, July 13, 2012, email: knill@math.harvard.edu