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:

What is the root problem here, and how can it be solved?
What are some other strategies for creating 3D text in an efficient manner?

@EvanCarslake It doesn't look like the size has a significant effect on the shape of the I. — bobthechemist, Oct 12 '16 at 01:51

score 26 · Answer 1 · answered Oct 11 '16 at 04:23

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

3D "Hello"

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

3D "I"

answered Oct 11 '16 at 04:23

J. M.'s missing motivation

124,525
11
401
574

1

So "extrude" is RegionProduct! Excellent! I was looking for this the other day. – Szabolcs Oct 11 '16 at 08:48
More specifically, the RegionProduct with a line segment. – J. M.'s missing motivation Oct 11 '16 at 08:55
1

@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.'s missing motivation Oct 13 '16 at 18:15

Greg Hurst · Accepted Answer · 2017-10-16T15:56:18.833

23

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]

edited Oct 16 '17 at 15:56

answered Oct 11 '16 at 05:42

Greg Hurst

35,921
1
90
136

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

Greg Hurst · Answer 3 · 2016-10-11T14:14:14.650

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

score 1 · Answer 4 · answered May 28 '23 at 14:02

1

Note, that the solution: DiscretizeGraphics[Text[Style["I", FontFamily -> "Source Code Pro"]], _Text] worked earlier on e.g. v11.3, but on v13.0 rather than creating a mesh of the formatted string 'I' it now creates one of the whole style expression instead: 'Style["I", FontFamily -> "Source Code Pro"]'

answered May 28 '23 at 14:02

Martin

11
1

3

This seems like a comment rather than an answer to the orriginal question. – bbgodfrey May 28 '23 at 15:19
True @bbgodfrey, as a new contributor, I don't think Martin could post comments. The behavior sounds like a bug; I don't have v13 installed as of yet to confirm. – bobthechemist May 29 '23 at 12:00

Strategies for creating 3D text

4 Answers4

Linked