14
$\begingroup$

1. Color a polyhedron

It is relatively easy to color a polyhedron using its polygon edge counts as color directive:

Color according to edge count

$color = 
  <|{3 -> Red, 4 -> Orange, 5 -> Yellow, 6 -> Darker @ Green, 8 -> Blue, 10 -> Purple}|>;

Define ColorPolygon

ColorPolygon[GraphicsComplex[v_, Polygon[poly_]]] := 
 GraphicsComplex[v, ({Glow @ $color[Length @ First @ #], Polygon @ #} &) /@ 
   SplitBy[Sort @ poly, Length]]

Example polyhedron

$poly = "GreatRhombicosidodecahedron";

Show it

Graphics3D[
 ColorPolygon[PolyhedronData[$poly, "GraphicsComplex"]],
 Boxed -> False,
 Lighting -> None]

enter image description here

2. Perforate a polyhedron

In his answer to Construction of a Fuller dome kglr showed how to perforate a polyhedron:

PerforatePolygon[width_ : 0.3, thickness_ : .05][bmesh_] := 
 MeshPrimitives[bmesh, 2] /. 
  Polygon[x_] :> Module[{c = Mean @ x, p1, p2},
    p1 = Partition[x, 2, 1, {1, 1}];
    p2 = Map[Reverse] @ Partition[Map[(c + (1 - width) (# - c)) &, x], 2, 1, {1, 1}];
    ReplaceAll[Polygon[y_] :> ConvexHullMesh[Join[y, (1 + thickness) y]]] @
     MapThread[Polygon @* Join] @ {p1, p2}]

Perforate $poly

Graphics3D[
 PerforatePolygon[0.2] @ PolyhedronData[$poly, "BoundaryMeshRegion"],
 Boxed -> False]

enter image description here

3. My question

I would like to use both, color and perforation, to highlight the structure of a polyhedron. Obviously, we cannot use the edge count (all polygons have 4) to color a perforated polygon, but are there alternate methods?

Here is a randomly found and over-simplified example of what I have in mind:

enter image description here

$\endgroup$

1 Answer 1

13
$\begingroup$
ClearAll[colorAndPerforatePolygon]
colorAndPerforatePolygon[width_ : 0.3, thickness_ : .05][bmesh_, colorrules_] := 
 KeyValueMap[{# /. colorrules, #2} &]@
   GroupBy[MeshPrimitives[bmesh, 2], Length@*First] /. 
  Polygon[x_] :> 
   Module[{c = Mean@x, p1, p2}, p1 = Partition[x, 2, 1, {1, 1}];
    p2 = Map[Reverse]@
      Partition[
       Map[If[Head[width] === Scaled, 
         # - First[width ] (# - c), 
         # - width Normalize[# - c]] &, x], 
       2, 1, {1, 1}];
    ReplaceAll[Polygon[y_] :> ConvexHullMesh[Join[y, (1 + thickness) y]]]@
     MapThread[Polygon@*Join]@{p1, p2}]

Examples:

$color = <|{3 -> Red, 4 -> Orange, 5 -> Yellow, 6 -> Darker@Green, 
    8 -> Blue, 10 -> Purple}|>;

Graphics3D[{EdgeForm[], 
  colorAndPerforatePolygon[0.2][
     PolyhedronData[$poly, "BoundaryMeshRegion"], $color]},
  Boxed -> False, Lighting -> "Neutral"]

enter image description here

Graphics3D[{EdgeForm[], 
  colorAndPerforatePolygon[Scaled @ 0.2][
     PolyhedronData[$poly, "BoundaryMeshRegion"], $color]},
  Boxed -> False, Lighting -> "Neutral"]

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ Wonderful, kglr, thank you so much $\endgroup$
    – eldo
    Commented Jan 7 at 10:17
  • 1
    $\begingroup$ @eldo, you are most welcome. $\endgroup$
    – kglr
    Commented Jan 7 at 10:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.