19
$\begingroup$

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]

enter image description here

text3D["I",5]

enter image description here

text3D["I am",5]

enter image description here

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?
Improve this question
$\endgroup$
2
  • $\begingroup$ Maybe text3D["I",1] $\endgroup$ – Evan Carslake Oct 12 '16 at 0:17
  • $\begingroup$ @EvanCarslake It doesn't look like the size has a significant effect on the shape of the I. $\endgroup$ – bobthechemist Oct 12 '16 at 1:51
22
$\begingroup$

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]

enter image description here

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

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

enter image description here

diff = RegionDifference[full, text]

enter image description here

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

enter image description here

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

enter image description here

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

FindMeshDefects[final]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ An interesting approach. I'm behind the times on my Mathematica versions and look forward to some of the new-to-v11 routines. $\endgroup$ – bobthechemist Oct 11 '16 at 11:25
  • $\begingroup$ 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. $\endgroup$ – bobthechemist Sep 15 '17 at 18:26
24
$\begingroup$

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"

Improve this answer
$\endgroup$
5
  • 1
    $\begingroup$ So "extrude" is RegionProduct! Excellent! I was looking for this the other day. $\endgroup$ – Szabolcs Oct 11 '16 at 8:48
  • $\begingroup$ More specifically, the RegionProduct with a line segment. $\endgroup$ – J. M.'s ennui♦ Oct 11 '16 at 8:55
  • 1
    $\begingroup$ @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. $\endgroup$ – bobthechemist Oct 11 '16 at 11:27
  • $\begingroup$ 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. $\endgroup$ – bobthechemist Oct 13 '16 at 18:13
  • $\begingroup$ Yeah, that will take a bit more work, @bob. Chip's solution looks fine, but let me think of a way to modify mine... $\endgroup$ – J. M.'s ennui♦ Oct 13 '16 at 18:15
15
$\begingroup$

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

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.