Wolfram Cloud Document

A friend of mine asked me to create 3D printed pieces such that when looked at from two different points of view different names will be seen. After watching a YouTube video I have come up with the following Wolfram Language code in this post. (Figure: the application of algorithm for the strings “QM” and “GR” which stand for quantum mechanics and general relativity.)

First we create a region from a letter. You can change the style options for different rendering of letters.

In[]:=

letterToRegion[a_]:=ImageMesh[ColorNegate[Rasterize[Text[Style[a,Bold,FontSize->120,Antialiasing->False]]]]]

An example:

In[]:=

letterToRegion["A"]

Out[]=

This function scales the region so that the height is 1.

In[]:=

normalizeRegion[r_]:=With[{bounds=RegionBounds[r]},Scale[r,1/(bounds[[2]][[2]]-bounds[[2]][[1]])]]

Function to translate the region to the origin.

In[]:=

regionToOrigin[r_]:=With[{bounds=RegionBounds[r]},Translate[r,-{bounds[[1]][[1]],bounds[[2]][[1]]}]]

Now we create two 3D regions of two letters. We will manipulate these objects later on.

In[]:=

createTwoRegions[r1_,r2_]:=With[{bounds1=RegionBounds[r1],bounds2=RegionBounds[r2]},{RegionProduct[r1,Line[{{0},{bounds2[[1]][[2]]}}]],RegionProduct[r2,Line[{{0},{bounds1[[1]][[2]]}}]]}]

We create such regions at the origin.

In[]:=

lettersTo3DRegions[a_,b_]:=createTwoRegions[regionToOrigin[normalizeRegion[letterToRegion[a]]],regionToOrigin[normalizeRegion[letterToRegion[b]]]]

As an example see the following:

In[]:=

lettersTo3DRegions["A","B"]

Out[]=





This function returns the center of the 3D region.

In[]:=

cRegion[r_]:=Mean/@RegionBounds[r]

Function to rotate the region around its center.

In[]:=

rotateRegionAroundCenter[r_,θ_]:=Rotate[r,θ,{0,1,0},cRegion[r]]

The function to fuse two letters, such that from two different point of views two distinct letters can be seen.

In[]:=

fuseLetters[a_,b_]:=With[{char3d=lettersTo3DRegions[a,b]},RegionIntersection[char3d[[1]],rotateRegionAroundCenter[char3d[[2]],π/2]]]

An example:

In[]:=

fuseLetters["A","B"]

Out[]=

Adding support to a region so that when 3D printed it can stand on its own. First parameter is the 3D region, second parameter is the radius of support and the last parameter is the thickness of the support.

In[]:=

addSupport[r_,rad_,th_]:=With[{r2=Region[Rotate[r,π/2,{1,0,0},{0,0,0}]]},RegionUnion[r2,Rotate[RegionProduct[Disk[Mean/@{RegionBounds[r2][[3]],RegionBounds[r2][[1]]},rad],Line[{{0},{th}}]],π,{1,0,0},{0,0,0}]]]

An example:

In[]:=