Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1996
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1996

[Date Index] [Thread Index] [Author Index]

Search the Archive

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




  • Prev by Date: a polyhedral function
  • Next by Date: PowerBook Woes
  • Previous by thread: a polyhedral function
  • Next by thread: PowerBook Woes