“Covering up” text in Graphics

Consider the following code:

Show[{Graphics3D[{Opacity[0.2], Sphere[], Opacity[1.0], Blue,
Polygon[{{-.2, -.3, -.3}, {-.2, .3, -.3}, {-.2, .3, .3}, {-.2, \
-.3, .3}}]}],
ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph], Cos[th]}, {th,
0, Pi}, {ph, 0, 2 Pi},
RegionFunction -> Function[{x, y, z}, Abs[x] < .9],
PlotRange -> {-1, 1}, PlotStyle -> Red, Mesh -> None]}]


(Doctored somewhat from another question on this site.) It produces a sphere, with an opaque red surface, except for two "portholes", which allow one to see the blue rectangle inside.

Now consider the following minor tweak, replacing the square by some text:

Show[{Graphics3D[{Opacity[0.2], Sphere[], Opacity[1.0], Blue,
Text["Surprise!", {0, 0, 0}]}],
ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph], Cos[th]}, {th,
0, Pi}, {ph, 0, 2 Pi},
RegionFunction -> Function[{x, y, z}, Abs[x] < .9],
PlotRange -> {-1, 1}, PlotStyle -> Red, Mesh -> None]}]


The output (which I don't know how to save as a rotating GIF [side question?]) shows the blue text over the red sphere, whether or not I am "looking" through the porthole or not.

The reason for this is in the help:

Text is drawn in front of all other objects.

Is there way to treat Text like other Graphics primitives, so that indeed it will be a "Surprise!" when you look through the porthole? That is, to get behavior similar to that of the blue rectangle?

Perhaps I should clarify I am most interested in being able to change the "z order" of the Text. But the fact that it doesn't rotate with the rest of the Graphics objects (using the mouse) is also kind of annoying.

Thanks!

You can use Inset:

  Show[{Graphics3D[{Opacity[0.2], Sphere[], Opacity[1.0], Blue,
Inset[Graphics[Text[Style["Surprise!", Green, 24]]], {0, 0, 0}]}],
ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph], Cos[th]}, {th,
0, Pi}, {ph, 0, 2 Pi},
RegionFunction -> Function[{x, y, z}, Abs[x] < .9],
PlotRange -> {-1, 1}, PlotStyle -> Red, Mesh -> None]}]


which gives

Alternatively, you can use Texture:

  text = Style["Surprise!!", 128];
vrtxtxtrcoords = {{0, 0}, {1, 0}, {1, 1}, {0,  1}};
Show[{Graphics3D[{Texture[text],
Polygon[{{-.2, -.3, -.3}, {-.2, .3, -.3}, {-.2, .3, .3}, {-.2,  -.3, .3}},
VertexTextureCoordinates -> vrtxtxtrcoords]},
Lighting -> "Neutral"],
ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph], Cos[th]}, {th, 0, Pi}, {ph, 0, 2 Pi},
RegionFunction -> Function[{x, y, z}, Abs[x] < .9],
PlotRange -> {-1, 1}, PlotStyle -> Red, Mesh -> None]}]


which gives

• I voted for this, then I un-voted because this doesn't appear to work on my system: "Inset is not a Graphics3D primitive or directive." Yet, Inset was supposedly last modified in v7. Is this just another documentation oversight or am I missing something? – Mr.Wizard Apr 27 '12 at 20:48
• @Mr.Wizard, it does work without error in V8.0.4.0. But Inset documentation does not include anything that suggest it would work. – kglr Apr 27 '12 at 22:19
• Inset in 3D is a V8 feature. Currently it is restricted to a form that always faces the user (like Text) but can be obscured by other objects (unlike Text.) – Brett Champion Apr 27 '12 at 23:04
• My vote is restored. – Mr.Wizard Apr 28 '12 at 7:37
• I had a tough time picking. In the end, the Texture method seems the easiest and closest to what I want. Thanks! – Steve D Apr 28 '12 at 16:37

For this purpose I made a function that puts an arbitrary expression into a 3D graphic. It's described on this page, going back originally to this MathGroup post, I'll copy the code here:

label3D[s_, pos_, xVec_, tiltAngle_, opts : OptionsPattern[]] :=
Module[{ra, width, height, r},
ra = Rasterize[
Style[HoldForm[s], FilterRules[{opts}, Options[Style]],
Magnification -> 10],
Evaluate@
Apply[Sequence, FilterRules[{opts}, Options[Rasterize]]],
"Image"];
{width, height} = ImageDimensions[ra];
r = SetAlphaChannel[ra,
With[{color =
Apply[List,
ColorConvert[
"TransparentColor" /. {opts} /. {"TransparentColor" ->
Apply[RGBColor, ImageData[ra][[2, 2]]]}, "RGB"]]},
Binarize[ra, (Norm[# - color] > .005) &]]];
Translate[(* //to make lefthand corner pos*)
Rotate[(*   //around z axis*)
Rotate[(* //around y axis*)
Rotate[(* //tilt around x axis*)
Scale[(*//to make width equal|
xVec|*){EdgeForm[FrameStyle /. {opts} /. FrameStyle -> None],
Texture[ImageData@r],(* //
Texture fills polygon initially in the xz plane*)
Polygon[{{0, 0, 0}, {width, 0, 0}, {width, 0, height}, {0, 0,
height}},
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0,
1}}]}, Norm[xVec]/width, {0, 0, 0}],
tiltAngle, {1, 0, 0}],(* //x rotation*)
Arg[Chop@N[Norm[xVec[[1 ;; 2]]] + I xVec[[3]]]], {0, -1,
0}],(* //y rotation*)
Arg[Chop@N[xVec[[1]] + I xVec[[2]]]], {0, 0, 1}],(* //z rotation*)
pos]];
SetAttributes[label3D, HoldFirst]


With this, you can draw your test as follows:

Show[{Graphics3D[{{Opacity[0.2], Sphere[]},
{Glow[Purple],
With[{position = {0, -.5, 0}, direction = {0, Cos[.1], Sin[.1]},
tiltAngle = 0},
label3D["Surprise!", position, direction, tiltAngle,
FontColor -> Blue, FontFamily -> "Helvetica"]
]}
}], ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph],
Cos[th]}, {th, 0, Pi}, {ph, 0, 2 Pi},
RegionFunction -> Function[{x, y, z}, Abs[x] < .9],
PlotRange -> {-1, 1}, PlotStyle -> Red, Mesh -> None]},
ViewPoint -> {2, .1, .5}]


Note that although the text was rasterized in this approach, the background is transparent. The text also maintains its orientation with respect to the other objects. I'm going with this rasterized approach because 3D graphics eventually always require rasterization anyway when you want to export them at a reasonable file size.

Since I was just doing another gif animation, I thought this post could also use one:

frames = Table[
Show[{Graphics3D[{{Opacity[0.2],
Sphere[{0, 0, 0}, .99]}, {Glow[Purple],
With[{position = {0, -.5, 0},
direction = {0, Cos[.1], Sin[.1]}, tiltAngle = 0},
label3D["Surprise!", position, direction, tiltAngle,
FontColor -> Blue, FontFamily -> "Helvetica"]]}}],
ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph], Cos[th]}, {th,
0, Pi}, {ph, 0, 2 Pi}, PlotPoints -> 30,
RegionFunction -> Function[{x, y, z}, Abs[x] < .9],
PlotRange -> {-1, 1}, PlotStyle -> Red, Mesh -> None]},
ViewVector -> {
3.5 {Cos[Pi/4 (1 - Sin[a/2]^2)],
Cos[a] Sin[Pi/4 (1 - Sin[a/2]^2)],
Sin[a] Sin[Pi/4 (1 - Sin[a/2]^2)]}, {0, 0, 0}},
ViewVertical -> {0, 0, 1}, ViewAngle -> .6,
ViewCenter -> {0, 0, 0}, Boxed -> False]
, {a, 0, 2 Pi, Pi/20}];
Export["surprise.gif", frames,
"DisplayDurations" ->
Join[.03 & /@ Range[20], {1}, .03 & /@ Range[20]]]


You can generate actual 3D data describing the text by Importing from PDF.

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


Or, in reference to Sjoerd's comment to the OP,

wordData = ImportString[ExportString[Style["\[Euro]",
FontFamily -> "Times"],
"PDF"], "PDF"][[1, 1, 2, 1, 1, 2]];
Graphics3D[Polygon /@ Map[Append[#, 0] &, wordData, {2}]]


Then, you can insert that in your image. The Tube primitive doesn't run too smoothly, though. Let's try a line.

word3D =Line /@  Map[{0,-0.5,-0.2}+Prepend[#,0]&,
wordData/40,{2}] ;
Show[{Graphics3D[{{Opacity[0.2], Sphere[]}, word3D}],
ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph], Cos[th]},
{th, 0, Pi}, {ph, 0, 2 Pi},
RegionFunction -> Function[{x, y, z}, Abs[x] < .9],
PlotRange -> {-1, 1}, PlotStyle -> Red, Mesh -> None]}]

• This is problematic with closed-shape characters. "oae" etc. do not render properly because holes are filled. Is there a workaround for that? – Yves Klett Apr 30 '12 at 9:13
• @Yves Imported PDF represents letters using FilledCurve, which represents holes easily. There should be enough information in the FilledCurve to extend to a 3D polygon representing the character with a hole. That's a bit more work, though, and is exactly why I used Tube and Line, rather than Polygon for the main answer. – Mark McClure Apr 30 '12 at 11:02
• Yup, with versions prior to 7 this worked just fine. That is why I fervently wish that FilledCurve were adapted to work as a 3D primitive as well. That should be awesome. I think David Park´s Presentation package offers something with a ParametricPlot based workaround, but workaround it remains... – Yves Klett Apr 30 '12 at 11:26
• @YvesKlett There's a Demonstration by Michael Schreiber that uses this Import[Export PDF technique to get polygons with holes projected onto a cube. That might help: demonstrations.wolfram.com/NumberedCube – Mark McClure Apr 30 '12 at 11:31