Strategies for creating 3D text

Question

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[
   ImageRotate@ImagePad[ImageReflect[
      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?

Answer 1

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]

Answer 2

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}]]]

Answer 3

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"];
text = ColorNegate[ImagePad[ImageCrop[hello], 6, White]];

stack = Image3D @ Join[
  ConstantArray[text, 20],
  ConstantArray[ColorConvert[ConstantImage[1, ImageDimensions[text]], "RGB"], 5]
];

ImageMesh[stack, Method -> "DualMarchingCubes"]