How to draw formatted text on a surface such as a sphere?

Question

Using Mathematica 9, I would like to write text over a surface, for example a sphere. Something like this:

I tried the code available here in MSE but the output is not so beautiful like shown.

I would like to setup, if possible, font, size, color, bold/italics/stroke, etc.

Engraving or embossing the text would be a very nice bonus:

i 've tried this:
text = Style["Hello!", 200]; R := 4; ParametricPlot3D[{R Sin[u] Cos[v],R s Sin[u] Sin[v], R Cos[u],, , {u, 0, Pi}, {v, 0, 2 Pi}, Boxed -> False, Axes -> False, Mesh -> False, PlotStyle -> {Directive[Texture[text]], Opacity[.5]}, TextureCoordinateFunction -> ({#4, #5} &)] — Humberto José Bortolossi, Apr 30 '23 at 09:44
Why not just do this in free 3D software like blender, then bring that model into Mathematica if you have to? Mathematica's own CSG operations like RegionUnion / RegionIntersection etc which you might consider for the engraving, are somewhat bug prone and difficult to use. The texture wrapping would be much easier in blender too. This question also seems subjective as it's not clear what you mean by not so beautiful. — flinty, Apr 30 '23 at 10:10
@flinty, i would like to stay with Mathematica and see its power of expression. also learning new software for every different task will decrease my chances to become a Mathematica proficient user. and making such demands may also serve as a stimulus for Mathematica programmers to improve the software. — Humberto José Bortolossi, Apr 30 '23 at 14:26
@HumbertoJoséBortolossi then perhaps a valuable lesson to learn about Mathematica is how to call into external libraries, or import data from external software. It would be unreasonable to expect Mathematica to be the perfect tool for the job in every case, which it is not, and being aware of its limitations may help you out more in the long run. — flinty, Apr 30 '23 at 15:10

kglr · Answer 1 · 2023-05-02T13:33:36.300

$Version

"13.1.0 for Linux x86 (64-bit) (June 16, 2022)"

bdg = BoundaryDiscretizeGraphics[
   Text[Style["hello", FontFamily -> "Cambria"]], _Text]

linecoords = (MeshPrimitives[bdg, 1, Multicells -> True] /. 
   Line[x_] :> Line[Join @@ x])[[All, 1]];
{xminmax, yminmax} = MinMax /@ Transpose[Join @@ linecoords];
rsT[newRanges_ : {{-Pi/4, Pi/4}, {-1/4, 1/4}}] := 
  RescalingTransform[{xminmax, yminmax}, newRanges];
spCoords = {Cos[#] Sin[ArcCos @ #2], Sin[#] Sin[ArcCos @ #2], #2} & @@@ 
 rsT[][#] & /@ linecoords;
Graphics3D[{Opacity[1], White, Tube[#, .02] & /@ spCoords, 
   MaterialShading[{"Glazed", Red}], Sphere[]}, 
 Boxed -> False, ImageSize -> 600, 
 Lighting -> "ThreePoint", ViewPoint -> {3, -1, 0.5}]

spCoords = {Cos[#] Sin[ArcCos@#2], Sin[#] Sin[ArcCos@#2], #2} & @@@ 
    rsT[{{-Pi/3, Pi/2}, {-1/3, 1/3}}][#] & /@ linecoords;
Graphics3D[{Opacity[1], White, Tube[#, .03] & /@ spCoords, 
    MaterialShading[{"Glazed", Red}], Sphere[]},
 Boxed -> False, ImageSize -> 600, 
 Lighting -> "ThreePoint", ViewPoint -> {3, -1, 0.5}]

For another example, take the surface produced by Plot3D:

f[x_, y_] := 2 Sin[x + y^2];
plot3D = Plot3D[f[x, y], {x, -3, 3}, {y, -2, 2}, 
   PlotStyle ->  MaterialShading[{"Glazed", Red}],
   Mesh -> False, BoundaryStyle -> None, Boxed -> False, 
   Axes -> False, Lighting -> "Neutral", PlotRange -> All, 
   SphericalRegion -> True];
surfaceCoords = ({#, #2, f[#, #2]} & @@@ 
   RescalingTransform[{xminmax, yminmax}, {{-3/2, 3/2}, {-1, 1}}]@#) & /@ 
  linecoords;
Show[plot3D, 
  Graphics3D[{Opacity[1], White, Tube[#, .05] & /@ surfaceCoords}], 
 ViewPoint -> {-0.5, -2, 2.5}]

I have mathematica 9, and the suggested code do not compile. for the hello example, yhe first error message is:
Part::partd: ((((""Part specification !((MeshPrimitives[BoundaryDiscretizeGraphics[*InterpretationBox[Cell[BoxData[\nFormBox[\nStyleBox[\"\\<\\\"hello\\\"\\>\",\nStripOnInput->False,\nFontFamily->\"Cambria\"], TextForm]], \"InlineText\"],\nText[Style[" hello) ", FontFamily -> ") Cambria) "]]], _Text], 1, Multicells -> True])[[All, 1]]) is longer than depth of object"") — Humberto José Bortolossi, May 02 '23 at 13:25
for the plot3d example, the first of many errors messages is: escalingTransform::inpf: {xminmax,yminmax} is not a list of length 2 vectors — Humberto José Bortolossi, May 02 '23 at 13:26
this code bdg = BoundaryDiscretizeGraphics[ Text[Style["hello", FontFamily -> "Cambria"]], _Text] does not produce any ouput in Mathemtica 9 — Humberto José Bortolossi, May 02 '23 at 13:29
@HumbertoJoséBortolossi, I added info on the version/os I am using. — kglr, May 02 '23 at 13:34

score 2 · Answer 2 · answered Apr 30 '23 at 14:39

This won't get you the embossing, but you can just use Texture:

ParametricPlot3D[
  {Sin[v] Cos[u], Sin[v] Sin[u], Cos[v]}, {u, 0, 2 Pi}, {v, 0, Pi}, 
  PlotStyle -> 
    Directive[
      Texture[
        ImageReflect[
          ImagePad[
            Rasterize[
              Style["sphere", FontSize -> 50, FontFamily -> "Marker Felt"]], {{800, 0}, {200, 100}}, White],
          Top]]]]

We re-orient the rasterized image with ImageReflect so that it reads as expected. ImagePad is just an easy way to push the text around the surface to where you want it.

i1ve tested your code in mathematica 9 and the text is not rendered only the sphewre sppears. — Humberto José Bortolossi, May 02 '23 at 13:33

score 1 · Answer 3 · edited May 06 '23 at 23:08

1

adapted from a chatGPT suggestion:

ParametricPlot3D[{Sin[v] Cos[u], Sin[v] Sin[u], Cos[v]}, {u, 0, 
      2 Pi}, {v, 0, Pi}, 
     PlotStyle -> 
      Directive[
       Texture[ImageReflect[
         ImagePad[
          Rasterize[
           Graphics[
            Text[Style["sphere", FontSize -> 50, 
              FontFamily -> "Marker Felt"], 
             Background -> LightBlue]]], {{800, 0}, {200, 100}}, 
          LightBlue], Top]]], TextureCoordinateFunction -> ({#4, #5} &), 
     Lighting -> "Neutral", Axes -> False, Boxed -> False, Mesh -> None]

output:

however i don't know how to rewrite the code in order to gave a gradient color over the sphere.

edited May 06 '23 at 23:08

cvgmt

72,231
4
75
133

answered May 02 '23 at 16:07

Humberto José Bortolossi

174
6

Please provide the image that this code produces. – bbgodfrey May 02 '23 at 17:51
@ bbgodfrey , done! – Humberto José Bortolossi May 02 '23 at 18:47
The code does not work, missing some [ – cvgmt May 05 '23 at 12:14
@cvgmt, i've updated the code, please, see if this works now! – Humberto José Bortolossi May 06 '23 at 19:41

How to draw formatted text on a surface such as a sphere?

3 Answers3