3
$\begingroup$

I'm seeking a refinement/extension of the excellent and very valuable solution appearing here.

That solution indeed allows you to place text anywhere in a 3D graphics and then rotate it (by Euler angles) so it faces any direction you like.

However... it has two important limitations for my application:

  • For some reason it does not handle subscripts and superscripts: they are lost and not rendered
  • The solution does not allow a background color, such as Background -> White. (I need this when I'm placing a label atop a black line and want to hide a short section of the line.)

In sum: I'm hoping to get a version of text3D that could work with Style, of the form:

text3D[Style[Subscript[x, o], Italic, 24, Background->Yellow], 
{x-position, y-position, z-position}, 
EulerAngle1, EulerAngle2, EulerAngle3]

Minor point: I think the Euler angles should be grouped into a List... but again, minor suggestion:

text3D[Style[Subscript[x, o], Italic, 24, Background->Yellow], 
{x-position, y-position, z-position}, 
{EulerAngle1, EulerAngle2, EulerAngle3}]

Here's an example of what I'm seeking, where I used text3D:

episcope

My original file is .eps (and .pdf) [I had to convert it to .png to upload to this site.] The labels on the artwork and mirror were created using text3D and have that wonderful orientation, as desired. However, the labels along the bottom do NOT have that orientation. I added them as standard Text in order to get the subscripts and Background -> White to cover the lines.

THAT is the problem I'd like to fix.

$\endgroup$
2
  • $\begingroup$ The original eps maybe create by Tikz or Asymptote etc. which support 3D TeX label. $\endgroup$ – cvgmt Feb 25 at 4:53
  • $\begingroup$ Does Tikz or Asymptote allow transparency of surfaces? (I need that too.). I also use Optica to create ray-tracing diagrams (e.g., green rays), and this is fully integrated with Mathematica. How would I do that with Tikz or Asymptote? I do presume you can map a texture (such as those paintings) onto a curved surface such as a barrel in Tikz or Asymptote.... right? $\endgroup$ – David G. Stork Feb 25 at 6:21
7
$\begingroup$

Perhaps you could use an adapted version of the billboard3D function that I adapted from a previous answer here How to write graffiti, i.e., text on a polygon surface in Graphics3D? that I ultimately adapted from a Wolfram-U video presentation Advanced 3D Graphics in the Wolfram Language. It uses normals rather than Euler angles, but it should be straightforward to convert to the flavor of Euler angles you desire. Here is an example:

Clear[billboard3D];
billboard3D[s_, 
   width_, {x_, y_, z_}, {nx_, ny_, nz_}, {hx_, hy_, hz_}, 
   bkgrd_ : None, raster_ : 1000] :=
  Module[{img = 
     Rasterize[s, "Image", Background -> bkgrd, RasterSize -> raster],
     height},
   height = width ImageAspectRatio[img];
   {
    FaceForm[White], EdgeForm[],
    Texture[ImageData[img]],
    GeometricTransformation[
     Polygon[{{-.5 width, .5 height, 0}, {.5 width, .5 height, 
        0}, {.5 width, -.5 height, 0}, {-.5 width, -.5 height, 0}}, 
      VertexTextureCoordinates -> {{0, 1}, {1, 1}, {1, 0}, {0, 0}}],
     Quiet@
      Composition[TranslationTransform[{x, y, z}], 
       RotationTransform[{{0, 1, 0}, {hx, hy, hz}}], 
       RotationTransform[{{0, 0, 1}, {nx, ny, nz}}]]]
    }
   ];

Framed[
 Graphics3D[{
   
   (* Add a Plot3D Object *)
   Plot3D[ 
     0.9 Exp[-9 ((x - 1/2)^2 + (y - 1/2)^2)], {x, 0, 1}, {y, 0, 1}, 
     PlotRange -> {0, 2}, ColorFunction -> "TemperatureMap", 
     PlotStyle -> Directive[Opacity[0.5], Red]][[1]],
   (* View frustum *)
   FaceForm[], EdgeForm[GrayLevel[.25]], Cuboid[],
   
   (* Camera *)
   FaceForm[GrayLevel[.25]], EdgeForm[], Specularity[White, 30],
   Cuboid[{.45, -1, .4}, {.55, -1.3, .6}],
   Cylinder[{{.475, -1.1, .65}, {.525, -1.1, .65}}, .05],
   Cylinder[{{.475, -1.2, .65}, {.525, -1.2, .65}}, .05],
   Cylinder[{{.5, -1, .5}, {.5, -.9, .5}}, .05],
   Cylinder[{{.5, -1.15, .5}, {.5, -.9, 0}}, .01],
   Cylinder[{{.5, -1.15, .5}, {.35, -1.3, 0}}, .01],
   Cylinder[{{.5, -1.15, .5}, {.65, -1.3, 0}}, .01],
   billboard3D[
    Style["ViewPoint", 24, Bold, 
     FontFamily -> "Courier"], .4, {.5, -1.15, .8}, {1, 0, 0}, {0, 0, 
     1}],
   
   (* View span *)
   GrayLevel[.25],
   With[{p = {.5, -.9, .5}}, 
    Line[{{p, {0, 0, 0}}, {p, {1, 0, 0}}, {p, {0, 0, 1}}, {p, {1, 0, 
        1}}}]],
   
   (* View angle *)
   Gray, Dashed,
   With[{p = {.5, -.9, .5}}, Line[{{p, {.5, 0, 1}, {.5, 0, 0}, p}}]],
   Arrowheads[{-.015, .015}], 
   Arrow[BezierCurve[{{.5, -.5, 
       0.28}, {.5, -.4, .5}, {.5, -.5, .72}}]],
   billboard3D[
    Style["ViewAngle", 24, Bold, 
     FontFamily -> "Courier"], .3, {.5, -.4, .45}, {1, 0, 0}, {0, 0, 
     1}],
   
   (* View vertical *)
   billboard3D[
    Style["ViewVertical", 24, Bold, 
     FontFamily -> "Courier"], .35, {.5, -.05, .75}, {1, 0, 
     0}, {0, -1, 0}],
   
   (* View center *)
   PointSize[Large], Point[{{.5, .5, .5}, {.5, 0, .5}}],
   Arrowheads[.015], Arrow[{{.5, .5, .5}, {.5, 0, .5}}],
   billboard3D[
    Style["ViewCenter", 24, Bold, 
     FontFamily -> "Courier"], .25, {.5, .25, .55}, {1, 0, 0}, {0, 0, 
     1}],
   
   (* View range *)
   Gray,
   Line[{{{1, 0, 0}, {1, 0, -.1}}, {{1, 1, 0}, {1, 1, -.1}}}],
   Arrowheads[{-.02, .02}], Arrow[{{1, 0, -0.05}, {1, 1, -.05}}],
   billboard3D[
    Style["ViewRange", 24, Bold, 
     FontFamily -> "Courier"], .4, {1.075, .5, -.1}, {1, 0, 0}, {0, 0,
      1}],
   
   (* View left wall *)
   billboard3D[
    Style["\!\(\*SubscriptBox[\(Left\), \(Wall\)]\)", 24, Bold, 
     FontFamily -> "Courier"], .35, {0, 0.5, .5}, {1, 0, 0}, {0, 0, 
     1}, Yellow],
   
   (* View right wall *)
   billboard3D[
    Style["\!\(\*SubscriptBox[\(Right\), \(Wall\)]\)", 24, Bold, 
     FontFamily -> "Courier"], .35, {1, 0.5, .5}, {1, 0, 0}, {0, 0, 
     1}, Green],
   
   (* View top wall *)
   billboard3D[
    Style["Top Wall", 24, Bold, FontFamily -> "Courier"], .35, {0.5, 
     0.5, 1}, {0, 0, 1}, {0, 1, 0}],
   
   (* View bottom wall *)
   billboard3D[
    Style["Bottom Wall", 24, Bold, 
     FontFamily -> "Courier"], .35, {0.5, 0.5, 0}, {0, 0, 1}, {0, 1, 
     0}],
   
   (* View front wall *)
   billboard3D[
    Style["Front Wall", 24, Bold, FontFamily -> "Courier"], .35, {0.5,
      0, 0.5}, {0, 0, 1}, {0, 0, 1}],
   
   (* View back wall *)
   billboard3D[
    Style["\!\(\*SuperscriptBox[\(Back\), \(Wall\)]\)", 24, Bold, 
     FontFamily -> "Courier"], .35, {0.5, 1, 0.5}, {0, 0, 1}, {0, 0, 
     1}, Orange]
   
   },
  Boxed -> False, ImageSize -> 750, Lighting -> "Neutral",
  ViewPoint -> {5, -2, 1.5}
  ],
 FrameMargins -> 20, FrameStyle -> GrayLevel[.75]]

Image

Update

I modified the billboard3D function to pass in an Euler angles and a translation list. In the process of testing the function, I noticed that it was difficult to match a white background, as shown below:

Off-white background

I could circumvent the issue by supplying a White Glow directive to Graphics3D as shown in the following workflow:

Clear[transformFn]
transformFn[angles_List, translation_List] := Module[{m},
  (* Set up Transform Function*)
  m = IdentityMatrix[4];
  (* Rotation Part *)
  m[[1 ;; 3, 1 ;; 3]] = EulerMatrix[angles];
  (* Translation Part *)
  m[[1 ;; 3, -1]] = translation;
  TransformationFunction[m]
  ]
Clear[billboard3DEuler];
billboard3DEuler[s_, width_, angles_List, translation_List, 
   bkgrd_ : None, raster_ : 1000] := 
  Module[{img = 
     Rasterize[s, "Image", Background -> bkgrd, RasterSize -> raster],
     height}, height = width ImageAspectRatio[img];
   {FaceForm[White], EdgeForm[], Texture[ImageData[img]], 
    GeometricTransformation[
     Polygon[{{-.5 width, .5 height, 0}, {.5 width, .5 height, 
        0}, {.5 width, -.5 height, 0}, {-.5 width, -.5 height, 0}}, 
      VertexTextureCoordinates -> {{0, 1}, {1, 1}, {1, 0}, {0, 0}}], 
     Quiet@transformFn[angles, translation]]}];
(*Set up unit vectors*)
null = {0, 0, 0};
(* Unit Vectors *)
{ex, ey, ez} = UnitVector[3, #] & /@ {1, 2, 3};
(*Create reference axes*)
axesfn = {Red, Arrow[Tube[{null, #1 ex}, #2]], Green, 
    Arrow[Tube[{{null, #1 ey}}, #2]], Blue, 
    Arrow[Tube[{{null, #1 ez}}, #2]]} &;
axes = Graphics3D@axesfn[4, 0.04];
(*Manipulate rotation and translation*)
Manipulate[Show[{axes, Graphics3D[{
     (* View left wall *)
     Glow[White], 
     billboard3DEuler[
      Style["\!\(\*SubscriptBox[\(x\), \(o\)]\)", 24,(*Bold,*)
       FontFamily -> "Lucida Calligraphy"], 
      1.5, {Dynamic@α, Dynamic@β, 
       Dynamic@γ}, {Dynamic@x, Dynamic@y, Dynamic@z}, White, 
      500]
     }]}, Boxed -> False, ViewPoint -> {Infinity, Infinity, Infinity},
   PlotRange -> 4 {{-1, 1}, {-1, 1}, {-0.5, 1}}, 
  ImageSize -> Large], {{α, 0}, 0, 2 Pi, Pi/2}, {{β, 0}, 
  0, 2 Pi, Pi/2}, {{γ, 0}, 0, 2 Pi, Pi/2}, {{x, 0}, -2, 
  2}, {{y, 0}, -2, 2}, {{z, 0}, -2, 2}, ControlPlacement -> Left]

Manipulate animation

$\endgroup$
7
  • $\begingroup$ This is very nice ($+1$) but text3D preserved eps format and didn't have to rasterize. Any way to ensure the eps format? (I couldn't figure it out and retain subscripts.) $\endgroup$ – David G. Stork Feb 24 at 5:28
  • $\begingroup$ @DavidG.Stork Thanks. I will have to investigate a bit. It may be difficult since we are using textures to create the effect. I have only done that with images. $\endgroup$ – Tim Laska Feb 24 at 14:26
  • $\begingroup$ @DavidG.Stork The text3D function used DiscretizeGraphics to convert the text into a mesh. Therefore, the eps format is not preserved. I added a raster option to the billboard3D function. You can increase the resolution of the font by increasing the raster size. $\endgroup$ – Tim Laska Feb 24 at 15:52
  • $\begingroup$ Ah yes, now that you pointed it out even text3D uses Raster. (So now I really don't understand the loss of subscripts!). Anyway, given all this, I think yours is acceptable ($\checkmark$). I do think Mathematica should, in future versions, support this kind of text orientation functionality in .eps. It really helps in certain complex figures. $\endgroup$ – David G. Stork Feb 24 at 17:51
  • $\begingroup$ Oh... thanks for the extra work. Except for the Rasterize (which may be necessary, but shouldn't be!), this is just what I need. $\endgroup$ – David G. Stork Feb 25 at 0:36

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.