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
------------------------------