# Strategies for creating 3D text

I am interested in using Mathematica to create 3D text for printing. I stumbled upon this answer which works very well in a slightly modified form:

text3D[text_String, mult_] := ListPlot3D[
ClusteringComponents[
ImageCrop@First@
ColorSeparate@
Rasterize@
Graphics[{Text[Style[text, Bold, 60]]}],
Left -> Right], 5, White]], Boxed -> False, Mesh -> False,
Axes -> False, DataRange -> {{0, mult}, {0, mult}}]


It seems to work well, except for one peculiar instance:

text3D["Hello",5]


text3D["I",5]


text3D["I am",5]


Something is unusual about printing just the letter "I", and I can't place my finger on it. Adding spaces around the I (" I ") does not have an effect, but printing ".I." does (although I would like to have the letter I by itself).

There are two questions:

1. What is the root problem here, and how can it be solved?
2. What are some other strategies for creating 3D text in an efficient manner?
• Maybe text3D["I",1] – Evan Carslake Oct 12 '16 at 0:17
• @EvanCarslake It doesn't look like the size has a significant effect on the shape of the I. – bobthechemist Oct 12 '16 at 1:51

With a bit more work, we can take a similar approach to J.M.'s answer to build a water tight model with a base.

text = BoundaryDiscretizeGraphics[Text["Hello"], _Text]


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

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


diff = RegionDifference[full, text]


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


final = DiscretizeGraphics @ Show[
etext,
RegionProduct[text, Point[{2.}]],
RegionProduct[diff, Point[{0.}]],
RegionProduct[full, Point[{-1.}]],
RegionProduct[RegionBoundary[full], Line[{{-1.}, {0.}}]]
]


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

FindMeshDefects[final]


• An interesting approach. I'm behind the times on my Mathematica versions and look forward to some of the new-to-v11 routines. – bobthechemist Oct 11 '16 at 11:25
• Building up the extruded text worked for my application and it doesn't take forever on a RPi, so this is the "right" answer for my question. However, there's a bunch of useful info in the other answers provided. – bobthechemist Sep 15 '17 at 18:26

What are some other strategies for creating 3D text in an efficient manner?

Here's one way, using MeshRegion[] functionality:

RegionProduct[DiscretizeGraphics[Text[Style["Hello", Bold, FontFamily -> "Calibri"]],
_Text, MaxCellMeasure -> 0.1],
MeshRegion[{{0}, {4}}, Line[{1, 2}]]]


RegionProduct[DiscretizeGraphics[Text[Style["I", FontFamily -> "Source Code Pro"]], _Text,
MaxCellMeasure -> 0.1],
MeshRegion[{{0}, {2}}, Line[{1, 2}]]]


• So "extrude" is RegionProduct! Excellent! I was looking for this the other day. – Szabolcs Oct 11 '16 at 8:48
• More specifically, the RegionProduct with a line segment. – J. M. will be back soon Oct 11 '16 at 8:55
• @Szabolcs I spent much of my searching time looking for "mathematica text extrusion". Your comment makes me think I should change the title of this question. – bobthechemist Oct 11 '16 at 11:27
• I like the speed and simplicity of this answer. The problem I'm having is that it does not seem to make manifold/watertight objects. I'm still debugging, and hoping it's some type of error with overlapping vertices that can be resolved. – bobthechemist Oct 13 '16 at 18:13
• Yeah, that will take a bit more work, @bob. Chip's solution looks fine, but let me think of a way to modify mine... – J. M. will be back soon Oct 13 '16 at 18:15

I'm posting a second answer because this method is completely different from my first answer.

Another way to make 3D printable text is with ImageMesh:

hello = Rasterize[Graphics[{Text[Style["Hello", Bold, 60]]}], "Image"];