a polyhedral function

*Subject*: [mg3029] a polyhedral function*From*: rustybel at foothill.net (Russell Towle)*Date*: 24 Jan 1996 15:37:16 -0600*Approved*: usenet@wri.com*Distribution*: local*Newsgroups*: wri.mathgroup*Organization*: Wolfram Research, Inc.*Sender*: mj at wri.com

Here is a function I have developed; it is based closely upon the Truncate function in the Polyhedra package. It fails when applied to certain types of polyhedra, such as torus knots. Any comments or suggestions would be welcome. The HollowPolygon function below operates upon any polyhedron, and replaces each face of the polyhedron with a hollow polygon. The original polygons need not be regular, nor of all the same number of sides. For instance, the uniform polyhedron #28 in Roman Maeder's Uniform Polyhedra package, with its mixture of squares, hexagons, and decagons, is quite pretty when transformed by HollowPolygon. The function accepts three arguments: poly, a polyhedron; k, by default 1, a parameter which will tilt the planes of the strips forming the hollow polygon either in (k<1) or out (k>1); and w, a parameter which determines the width of the strips forming the hollow polygon. HollowFace[face_List, k_, w_] := Block[{apex, i, f=Length[face]}, apex = N [k (Plus @@ face)/f]; rad=w/Sin[Pi/f]; Table[ Polygon[ {((apex-face[[i]])/rad)+face[[i]], face[[i]], face[[ Mod[i, f] + 1 ]], ((apex-face[[Mod[i, f] + 1]])/rad)+face[[Mod[i, f]+1]] }], {i, f} ] ] HollowPolygon[poly_, k_:1, w_:2] := Flatten[ poly /. Polygon[x_] :> HollowFace[x, k, w] ] /; NumberQ[N[k]] Needs["Graphics`Polyhedra`"] q=Polyhedron[Dodecahedron]; Show[HollowPolygon[q,1,2], Boxed->False, Axes->False, Background->GrayLevel[0], ViewPoint->{.25,1.5,1.5}] Russell Towle Giant Gap Press, Dutch Flat, California ------------------------------ Voice: (916) 389-2872 e-mail: rustybel at foothill.net ------------------------------