# Performing geometric transforms on 3D text inside a Graphics3D expression

I am trying to put some 3D text inside a 3D graphics. So far I find two ways to make 3D text.

halirutan in "Rotating an image along a Möbius strip?")

wordData = ImportString[ExportString["Mathematica", "PDF"], "PDF"][[1, 1, 2, 1, 1, 2]];
Graphics3D[Tube[#, 0.2] & /@ Map[Append[#, 0] &, wordData, {2}]]


J.M. in "Strategies for creating 3D text"

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


halirutan's method gives a set of coordinates which is easy to manipulate (for example - change position, orientation, colour etc.)

word1=ImportString[ExportString["Hello","PDF"],"PDF"][[1,1,2,1,1,2]];
(*scale=0.5; rotation Pi/4 around {0,1,1}*)
wline1=Map[RotationTransform[Pi/4,{0,1,1}][0.5Join[#,{0}]]&,word1,{2}];

word2=ImportString[ExportString["World","PDF"],"PDF"][[1,1,2,1,1,2]];
(*scale=0.2; shift {1,0,-1}*)
wline2=Map[(0.2Join[#,{0}]+{1,0,-1})&,word2,{2}];

Graphics3D[{Green, Sphere[],
Blue, Map[Tube[#, 0.3] &, wline1], Red, Map[Tube[#, 0.3] &, wline2]}]


How can I do the same thing with J.M.'s method?

• @andre, Thanks, I was not familiar with this option. So I can control the position and orientation with TranslationTransform and RotationTransform. Now I am left with size and colour. I am playing with RegionResize, but can't fix it properly. Should I modify my question with this information or would you like to post a compact answer? – Sumit Nov 10 '17 at 17:50
• Note that the accepted solution is not viable in v11.3 due to a bug. – bobthechemist Jul 20 '18 at 0:05

Alternatively, extract the points and Polygon[]s with MeshCoordinates[] and MeshCells[], and then apply any transformation function to the points before passing to GraphicsComplex[], like so:

message = RegionProduct[DiscretizeGraphics[Text[Style["Mathematica", Bold,
FontFamily -> "Calibri"]],
_Text, MaxCellMeasure -> 0.1],
MeshRegion[{{0}, {2}}, Line[{1, 2}]]];

sc = Max[Abs[Flatten[RegionBounds[message]]]];
pts = Composition[ScalingTransform[{1, 1, 1}/sc], RotationTransform[π/2, {1, 0, 0}]] @
MeshCoordinates[message];
polys = MeshCells[message, 2];

Graphics3D[GraphicsComplex[AffineTransform[RollPitchYawMatrix[{π/3, -π/4, π/6}]][pts],
{Directive[EdgeForm[], Pink], polys}], Axes -> True]


• Just what I am looking for - raw data :) – Sumit Nov 11 '17 at 13:10
region1=RegionProduct[
DiscretizeGraphics[Text[Style["Hel", Bold, FontFamily -> "Times"]],
_Text, MaxCellMeasure -> 0.1], MeshRegion[{{0}, {2}}, Line[{1, 2}]]];

region2=RegionProduct[
DiscretizeGraphics[Text[Style["lo", Bold, FontFamily -> "Times"]],
_Text, MaxCellMeasure -> 0.1], MeshRegion[{{0}, {2}}, Line[{1, 2}]]];

region2Rotated=TransformedRegion[region2,RotationTransform[Pi/2, {1, 0, 0}]];

region2RotatedTranslated=TransformedRegion[region2Rotated,TranslationTransform[ {12, 0, 3}]];

RegionPlot3D[{region1,region2RotatedTranslated}]


I seem to recall that in a video, Stephen Wolfram himself says that TranslationTransform directly applied to a Region should work.
Maybe soon...

• Great! The last line gives RegionPlot3D::argr: RegionPlot3D called with 1 argument; 4 arguments are expected. (MMA11.1). RegionPlot3D[region1] is working fine. Would you like to comment on the controlling the size? – Sumit Nov 10 '17 at 18:33
• I don't have the error message "1 argument.." neither on 11.0 nor on 11.2 (I don't have 11.1) – andre314 Nov 10 '17 at 18:38
• Concerning "size controlling", I don't see very well what you mean and I'm not a expert. You can ask the question in the chat. I will see if I know something interesting. – andre314 Nov 10 '17 at 18:40
• I modified my question to clarify what I am looking for. At the end, I have to combine different object with Graphics3D like Show[Graphics3D[Sphere[]], RegionPlot3D[region1], RegionPlot3D[region2]] – Sumit Nov 11 '17 at 8:52