将文本添加到多面体的面

时间:2011-11-16 15:24:17

标签: wolfram-mathematica

是否可以自动将任何文本添加到多面体的面上,如此手动绘制的图形显示(示例的奇数编号方案不相关):

labelled faces of dodecahedron

标记顶点很容易:

c = 1;
Show[{Graphics3D[
   Text[c++, #] & /@ PolyhedronData["Dodecahedron", "VertexCoordinates"]], 
   PolyhedronData["Dodecahedron"]},
   Boxed -> False]

labelled edges of dodecahedron

(即使一些文本放在隐藏顶点的形状前面。这可能是可溶的。)

但是当我试图为面孔做同样的事情时,没有任何效果。 PolyhedronData["Dodecahedron", "Faces"]返回GraphicsComplex,而不是坐标。

我是否忽略了一个简单的解决方案/选项?

编辑:感谢这些答案,他们都很棒。如果我能将szabolcs的答案的文本放置与belisarius的文本质量相结合,那么完美的解决方案就在眼前!

2 个答案:

答案 0 :(得分:14)

这是一种时髦的方法:

(* this function just transforms the polygon onto the [0,1] 2D square *)
vtc[face_, up_:{0,0,1}] := Module[{pts, pts2, centre, r, r2, topmost},
  pts = N@face;
  centre = Mean[pts];
  pts = (# - centre & /@ pts);
  r = SingularValueDecomposition[pts][[3]];

  (* these two lines ensure that the text on the outer face 
     of a convex polyhedron is not mirrored *)
  If[Det[r] < 0, r = -r];
  If[Last[centre.r] < 0, r = r.RotationMatrix[\[Pi], {1, 0, 0}]];

  pts2 = Most /@ (pts.r);
  topmost = Part[pts2, First@Ordering[up.# &  /@ pts, -1]];
  r2 = Transpose[{{#2, -#1} & @@ topmost, topmost}];
  r2 /= Norm[r2];
  Rescale[pts2.r2]
]

faces = First /@ First@Normal@PolyhedronData["Dodecahedron", "Faces"];

numbers = 
  Graphics[Text[
      Style[#, Underlined, FontFamily -> "Georgia", 
       FontSize -> Scaled[.3]]]] & /@ Range@Length[faces];

Graphics3D[
 MapThread[{Texture[#1], 
    Polygon[#2, VertexTextureCoordinates -> vtc[#2]]} &, {numbers, 
   faces}],
 Boxed -> False
 ]

enter image description here

摧毁"SmallRhombicosidodecahedron"

enter image description here

答案 1 :(得分:13)

a = PolyhedronData["Dodecahedron", "Faces"] /.    GraphicsComplex -> List;
c = 1;
Show[{Graphics3D[
   Text[c++, #] & /@ (Mean /@ (a[[1, #]] & /@ a[[2, 1]]))], 
    PolyhedronData["Dodecahedron"]}, Boxed -> False]

修改

也许更好:

Show[{Graphics3D[
         MapIndexed[Text[#2, #1] &, 
             Mean /@ (PolyhedronData["Dodecahedron", "VertexCoordinates"][[#]] & /@ 
                      PolyhedronData["Dodecahedron", "FaceIndices"])]], 
         PolyhedronData["Dodecahedron"]}, Boxed -> False]

修改

text = Style[#, 128] & /@ Range[12]
Graphics3D@
 Riffle[Texture /@ text, 
       (Append[#1, {VertexTextureCoordinates -> 
          With[{n = Length[First[#1]]}, Table[1/2 {Cos[2 Pi i/n], Sin[2 Pi i/n]}+ 
                                           {1/2, 1/2}, {i, 0, n - 1}]]}] &) /@ 
   Flatten[Normal[PolyhedronData["Dodecahedron", "Faces"]]]]

enter image description here