rotating 3d text
As I was going to post this, I saw cormullion's comment. Anyway, as the linked answer by Heike shows, this works:
r = Rasterize[Pane[Style["Mathematica Mathematica ", 128],2100]];
text = SetAlphaChannel[r, ColorNegate[r]];
g = ParametricPlot3D[{Cos[theta], Sin[theta], rho}, {theta, -Pi,
Pi}, {rho, 0, 1}, PlotStyle -> Texture[ImageData@text],
Lighting -> "Neutral", Mesh -> None, MeshShading -> None,
PlotRange -> All, TextureCoordinateScaling -> True, Boxed -> False,
Axes -> False, SphericalRegion -> True,
Background -> Lighter[Orange]]
The main point is that you have to precede the Texture
argument by ImageData
. This is a bug that is also discussed in this answer and the link I included there.
Instead of Background -> None
as Heike used, I use SetAlphaChannel
to choose where the transparent regions show up. To control the width of the text label, I added a Pane
wrapper.
This question is closely related to the Möbius strip 3D text question. Since the extraction of font curves through "PDF" export of text is not well-known and it is the specific transformation you're having problems with, let me give you the code for creating this:
It is possible to get the outline of a font by ex- and importing a text as "PDF". With this, you get FilledCurve
's for your text which you then can simply transform to a Graphics3D
.
The transformation from 2D text to 3D is {x_Real, y_Real} :> {Cos[x], Sin[x], y}
and can be found at the end in the code. The rotation is done by creating a list of images where I add dphi
to the angles of the above transformation.
As result you have in out
a list of graphics which can be used for instance in ListAnimate
With[{text =
First[First[
ImportString[
ExportString[
Style["Ah, gravity, thou art a heartless bitch -", Italic,
FontSize -> 24, FontFamily -> "Helvetica"], "PDF"], "PDF",
"TextMode" -> "Outlines"]]]},
Block[{allx, ally, meany, minmax}, {allx, ally} =
Transpose[Cases[text, {_Real, _Real}, Infinity]];
minmax = {Min[allx], Max[allx]};
meany = ((Max[#1] - Min[#1])/2. &)[
Rescale[ally, minmax, {0, 2*Pi}]];
out = Table[
Graphics3D[
text /. FilledCurve[_, pts_] :>
With[{scaledPts =
Rescale[pts, minmax, {0, 2*Pi}]}, {ColorData[
"IslandColors", scaledPts[[1, 1, 1]]/(2.*Pi)],
Tube[scaledPts /. {x_Real, y_Real} :>
2 {Cos[x - dphi], Sin[x - dphi], 2 y}
]}], Boxed -> False, ViewPoint -> {1.5, 0, 0.2},
ViewCenter -> {0.5, 0.5, 0.5}],
{dphi, 0, 2 Pi, .2}]
]];