Wolfram Technology Conference 2016
Geometry Lab

Wolfram Research

3D Printing

Version 11 provides fully integrated capabilities to directly 3D print geometric models, using either an online printing service or your own printer. Algorithmically generate geometric models or import 3D models from files and immediately output physical 3D objects — all highly automated for easy use unlike anything ever seen before.

How to create 3D printable text

Turn 2D text into a 3D printable model.

text="Hello";

Solution 1

Obtain a discretized version of the text:

mesh=BoundaryDiscretizeGraphics[Text[Style["Hello",Bold,FontFamily->"Calibri"]],_Text]

Use RegionProduct to extrude the text:

model=RegionProduct[mesh,Line[{{0.},{2.}}]]

Solution 2

First, convert your text into an image:

raw=Rasterize[Graphics[{Text[Style[text,Bold,60]]}],"Image"];

im=ColorNegate[ImagePad[ImageCrop[raw],6,White]]

Create a base for your text to sit on. This can simply be a blank image:

base=ColorConvert[ConstantImage[1,ImageDimensions[im]],"RGB"];

Create a 3D image by stacking multiple copies of the text and base:

stack=Image3D@Join[
ConstantArray[im,20],
ConstantArray[base,5]
]

Convert the image to a solid model:

model=ImageMesh[stack]

Use the method “DualMarchingCubes” to smooth out hard edges:

ImageMesh[stack,Method->"DualMarchingCubes"]

Solution 3

The goal is to manually construct a water tight 3D model of text with a base.

Obtain a discretized version of your text, just as in Solution 1:

mesh=BoundaryDiscretizeGraphics[Text[text],_Text]

Create a (padded) base for the text to sit on:

elongate[{a_,b_}]:=With[{d=0.05 (b-a)},{a-d,b+d}]

full=DiscretizeGraphics[Rectangle@@Transpose[elongate/@RegionBounds[mesh]]]

The top of the base will have the text cut out:

diff=RegionDifference[full,mesh]

Extrude the boundary of the text:

etext=RegionProduct[RegionBoundary[mesh],Line[{{0.},{2.}}]]

Extrude the boundary of the base:

ebase=RegionProduct[RegionBoundary[full],Line[{{-1.},{0.}}]]

Assemble all components, embedding into 3D where necessary:

model=DiscretizeGraphics[Show[
RegionProduct[mesh,Point[{2.}]],
etext,
RegionProduct[diff,Point[{0.}]],
ebase,
RegionProduct[full,Point[{-1.}]]
]]

The only defects here are misoriented faces (which can be fixed with RepairMesh), but this is indeed a water tight model:

FindMeshDefects[model]

Use 2D slices to create a 3D region

Given a collection of 2D slices, construct a 3D object meant for 3D printing.

sliceData=CloudGet["https://wolfr.am/gzACS8yT"];

Graphics3D[Line[sliceData]]

Solution 1

The goal is to create a solid object using ImageMesh.

First, convert each slice into an image, all with the same dimensions:

pr=AbsoluteOptions[Graphics[Polygon[sliceData[[All,All,1;;2]]]],PlotRange];

ims=Rasterize[Graphics[Polygon[#[[All,1;;2]]],pr],"Image"]&/@sliceData;

Multicolumn[ims[[;;;;11]]]

Create a 3D image with the slices:

im3d=Image3D[ColorNegate/@Reverse[ims]]

Use ImageMesh to create a solid mesh object. The method “DualMarchingCubes” will help smooth out hard edges:

head=ImageMesh[im3d,Method->"DualMarchingCubes"]

Resize the model to have more realistic box ratios:

head=RegionResize[RegionBoundary[head],{11,6,7}]

Solution 2

The goal is to interpolate the points with a BSplineSurface, then discretize and repair.

First, interpolate each individual slice:

loopsBSF=BSplineFunction/@sliceData;

ParametricPlot3D[#[t]&/@loopsBSF,{t,0,1},PlotStyle->Thickness[0]]

Create the spline surface:

highResData=Table[loopsBSF[[k]][t],{k,Length[sliceData]},{t,0,1,.001}];
surfBSF=BSplineFunction[highResData,SplineClosed->{False,True}];

Visualize:

plot=ParametricPlot3D[surfBSF[u,v],{u,0,1},{v,0,1},Mesh->All]

Discretize the plot and close the holes with RepairMesh:

RepairMesh[DiscretizeGraphics[plot]]

Sample more points with a higher PlotPoints setting:

RepairMesh[DiscretizeGraphics[ParametricPlot3D[surfBSF[u,v],{u,0,1},{v,0,1},PlotPoints->50]],PlotTheme->"SmoothShading"]

Core Geometry

The Wolfram Language has broad support for geometric computation over regions. Several standard properties can be directly computed for every region, such as membership tests, measure, centroid, nearest points, etc. Regions can also be used as specifications for many high-level solvers, including optimization, algebraic equation solving, integration, and partial differential equation solving.

Simulate a camshaft

Model the height of the following camshaft as the cam rotates about a point.

shaft=StadiumShape[{{1,3},{1,6}},1];
cam=StadiumShape[{{0,0},{6,0}},2];

Graphics[{
FaceForm[],PointSize[Large],
{EdgeForm[Thick],Point[{0,0}],cam},
{EdgeForm[{Thick,Red}],shaft},
{Arrowheads[.025],With[{r=.4},Arrow[Table[{r Cos[θ],r Sin[θ]},{θ,-3π/4+π/12,π/2-π/12,π/12}]]]},
{Red,Arrowheads[{-.04,.04}],Arrow[{{5/2,4},{5/2,6}}]}
}]

Solution

To solve this problem, write a function that takes an angle of rotation α and returns the height of the shaft.

First, rotate the cam by α radians.
Then use FindRoot to find the height where the shaft point has RegionDistance to the cam which equals the radius of the shaft tip:

height[α_?NumericQ]:=
With[{camα=TransformedRegion[cam,RotationTransform[α]]},
y/.FindRoot[RegionDistance[camα,{1,y+3}]==1,{y,10}]
]

Find the height at some angles of rotation:

Table[height[α],{α,0,2π,π/6}]

Plot angle of rotation versus height:

Plot[height[α],{α,0,2π},PlotRange->{0,Automatic}]

Use ListAnimate to visualize the cam follower system:

frames=Table[
Graphics[{
EdgeForm[Thick],FaceForm[],PointSize[Large],Point[{0,0}],
TransformedRegion[cam,RotationTransform[α]],
EdgeForm[{Thick,Red}],TransformedRegion[shaft,TranslationTransform[{0,height[α]}]]
},PlotRange->{{-8,8},{-8,12}}],
{α,0,2π-π/48,π/48}
];

ListAnimate[frames]

Find geographic regions that meet at a point

Given a collection of geographic regions, find groups of 4 or more regions that all meet at the same point.

regions=EntityList[(EntityClass["US counties in Florida", EntityClass["AdministrativeDivision","USCountiesFlorida"], "EntityClass[\"AdministrativeDivision\", \"USCountiesFlorida\"]", "administrative divisions"])];

locs={(Entity["Glades County, Florida, United States", Entity["AdministrativeDivision",{"GladesCounty","Florida","UnitedStates"}], "Entity[\"AdministrativeDivision\", {\"GladesCounty\", \"Florida\", \"UnitedStates\"}]", "administrative division"]),(Entity["Hendry County, Florida, United States", Entity["AdministrativeDivision",{"HendryCounty","Florida","UnitedStates"}], "Entity[\"AdministrativeDivision\", {\"HendryCounty\", \"Florida\", \"UnitedStates\"}]", "administrative division"]),(Entity["Martin County, Florida, United States", Entity["AdministrativeDivision",{"MartinCounty","Florida","UnitedStates"}], "Entity[\"AdministrativeDivision\", {\"MartinCounty\", \"Florida\", \"UnitedStates\"}]", "administrative division"]),(Entity["Okeechobee County, Florida, United States", Entity["AdministrativeDivision",{"OkeechobeeCounty","Florida","UnitedStates"}], "Entity[\"AdministrativeDivision\", {\"OkeechobeeCounty\", \"Florida\", \"UnitedStates\"}]", "administrative division"]),(Entity["Palm Beach County, Florida, United States", Entity["AdministrativeDivision",{"PalmBeachCounty","Florida","UnitedStates"}], "Entity[\"AdministrativeDivision\", {\"PalmBeachCounty\", \"Florida\", \"UnitedStates\"}]", "administrative division"])};
cols=ColorData[112]/@Range[5];
GeoGraphics[{EdgeForm[Black],MapThread[{GeoStyling[#2], Tooltip[Polygon[#1], CommonName[#1]]}&, {locs, cols}]},PlotLabel->Style[(Entity["Florida, United States", Entity["AdministrativeDivision",{"Florida","UnitedStates"}], "Entity[\"AdministrativeDivision\", {\"Florida\", \"UnitedStates\"}]", "administrative division"]),20]]

Solution

First, obtain the polygon for each region:

polys=EntityValue[regions,"Polygon","EntityAssociation"]/.GeoPosition->Identity;

Write a function that determines if two MeshRegions have a common vertex:

vertexInCommon[r_,r_]=False;

vertexInCommon[r1_,r2_]:=
Or[
Or@@rm[r1][Cases[polys[r2],{__Real},∞]],
Or@@rm[r2][Cases[polys[r1],{__Real},∞]]
]

rm=RegionMember/@polys;

Find the relationship graph that indicates the pairs of regions that share a common vertex:

pos=Reverse/@EntityValue[regions,"Coordinates"];
g=RelationGraph[vertexInCommon,Keys[polys],VertexCoordinates->pos]

Use FindClique to find candidate groupings that all meet at a point:

candidates=FindClique[g,{4,∞},All]

To verify the results, we need to make sure there is a vertex that is a member of all regions:

multiVertexInCommon[r1_,rs__]:=
AnyTrue[
Cases[polys[r1],{__Real},∞],
With[{p=#},AllTrue[rm/@{rs},#[p]&]]&
]

Remove extraneous results:

multipts=Pick[candidates,multiVertexInCommon@@@candidates]

Length[multipts]

Length/@multipts

Visualize:

GeoGraphics[{EdgeForm[Black],Red,Polygon/@multipts}]

Simulate waves over a region

Solve the wave equation over a region.

reg=RegionDifference[RegionUnion[Disk[],Rectangle[{0,0},{2,2}]],Disk[{1/4,1/4},1/5]];

Solution

Discretize the region:

Ω=DiscretizeRegion[reg,MaxCellMeasure->.0025]

Define the equation and all initial and boundary conditions:

pde=(∂_(t,t))u[t,x,y]-(InactiveLaplacian[u[t,x,y], {x,y}, Inactive])==0;

ic1=u[0,x,y]==2Exp[-10((((x-3/2))^2)+(((y-3/2))^2))];

ic2=Derivative[1,0,0][u][0,x,y]==0;

(Subscript[Γ, d])=DirichletCondition[u[t,x,y]==0,True];

Solve the equation over Ω:

inf=NDSolveValue[{pde,ic1,ic2,(Subscript[Γ, d])},u,{t,0,2 π},{x,y}∈Ω]

Visualize the waves over time:

frames=Table[Plot3D[inf[t,x,y],{x,y}∈Ω,PlotRange->{-1,2},Boxed->False,Axes->False,Mesh->None],{t,0,2π,π/6}];

ListAnimate[frames]

Make a spherical cow

Find a homotopic transformation that turns a cow into a sphere.

Solution

Get a cow as a mesh region:

cow=ExampleData[{"Geometry3D","Cow"},"MeshRegion"]

Take its coordinates:

coords=MeshCoordinates[cow];

Find a tight bounding sphere:

boundary=RegionBoundary[BoundingRegion[cow,"MinBall"]];

Compute the nearest point on the sphere to each vertex of the cow:

npts=RegionNearest[boundary,coords];

Use Manipulate to see the cow morph into a sphere:

cells=MeshCells[cow,2];
Manipulate[MeshRegion[(1-t) coords+t npts,cells,MeshCellStyle->{1->Black}],{{t,1},0,1},SaveDefinitions->True]

Learn More

Marketing Pages

Symbolic Geometry (Overview) [web]

Basic & Formula Regions [web]

Data & Mesh Regions [web]

PDEs & Finite Elements [web]

Core Geometry [web]

3D Printing [web]

Guide Pages

Geometric Computation (General Overview) [product] [web]

Plane Geometry (Special Overview) [product] [web]

Solid Geometry (Special Overview) [product] [web]

Region Properties & Measures [product] [web]

Solvers over Regions [product] [web]

3D Printing [product] [web]

Basic Geometric Regions [product] [web]

Mesh-Based Geometric Regions [product] [web]

Derived Geometric Regions [product] [web]

More geometry talks

What’s New in Geometry

Wednesday 1:00 - 1:30 PM

Spartan/Golden Gopher

Geometry Lab: From 3D Printing to Game Engines

Wednesday 4:00 - 5:00 PM

Badger

3D Printing

Wednesday 5:00 - 5:30 PM

Spartan/Golden Gopher

Meshes from Everywhere

Thursday 9:30 - 10:00 AM

Spartan/Golden Gopher

Game Engines

Friday 4:30 - 5:00 PM

Fighting Illini