3
$\begingroup$
Manipulate[Module[{},
  a1 = Map[Translate[{Scale[s1, 0.5 {1, 1, 1}, {0, 0, 0}]}, #] &, 
    grow3 tetv];
  a2 = Map[
    Translate[{Scale[{{RGBColor[0.3, 1, 0.2], s1}, a1}, 
        0.5 {1, 1, 1}, {0, 0, 0}]}, #] &, grow2 tetv];
  a3 = Map[
    Translate[{Scale[{{RGBColor[1, 0.3, 0.6], s1}, a2}, 
        0.5 {1, 1, 1}, {0, 0, 0}]}, #] &, grow1 tetv];
  graphics3d = 
   Graphics3D[{s1, a3}, Boxed -> False, SphericalRegion -> True, 
    ViewAngle -> 0.2, ViewPoint -> {-1.5, -4, 0.2}, ImageSize -> 470, 
    PlotRange -> {{-0.4, 0.6}, {-0.56, 0.6}, {-0.3, 0.65}}]],
 {{grow1, 0.5, "stage 1"}, 0.17, 0.5, ImageSize -> Tiny},
 {{grow2, 0.5, "stage 2"}, 0.17, 0.5, ImageSize -> Tiny},
 {{grow3, 0.5, "stage 3"}, 0.17, 0.5, ImageSize -> Tiny},
 "",
 "show tetrahedron",
 {{tetgr, 0.3, ""}, 0.3, 1, ImageSize -> Tiny},
 ControlPlacement -> Left,
 TrackedSymbols :> {grow1, grow2, grow3, tetgr}, 
 Initialization :> (
   tv = N[1/(2 Sqrt[6])];
   oct = PolyhedronData["Octahedron", "Faces"];
   s1 = Scale[
     Rotate[Rotate[oct, Pi/4, {0, 0, 1}], ArcTan[Sqrt[2]], {0, 1, 0}],
      0.5 {1, 1, 1}];
   tet = PolyhedronData["Tetrahedron", "Faces"];
   tetv = PolyhedronData["Tetrahedron", "VertexCoordinates"];)]

Export["graphics3d.stl", graphics3d]

Export::nodta: Graphics3D contains no data that can be exported to the STL format.

$Failed

What is a problem ?

$\endgroup$
4
$\begingroup$

Scale does work in strange ways. I think it is a design flaw that some transformations are only carried out during rendering (or that Normal works on Translate, but not on Scale). This makes geometric computations very awkward at times. Ah, well.

The following is a horrible frankenfix to make your example work. Essentially, you need to define your own transformation functions and use Normal to get proper coordinates from Translate:

scale[g_, scale_] := 
 g /. {x_?NumericQ, y_?NumericQ, z_?NumericQ} :> scale*({x, y, z})

scale[g_, scale_, o_] := 
 g /. {x_?NumericQ, y_?NumericQ, z_?NumericQ} :> scale*({x, y, z} - o)+o

Manipulate[
 Module[{}, 
  a1 = Map[Translate[{Scale[s1, 0.5 {1, 1, 1}, {0, 0, 0}]}, #] &, 
    grow3 tetv];
  a2 = Map[
     Translate[{Scale[{{RGBColor[0.3, 1, 0.2], s1}, 
          a1}, .5 {1, 1, 1}, {0, 0, 0}]}, #] &, grow2 tetv] // Normal;
  a3 = Map[
     Translate[{scale[{{RGBColor[1, 0.3, 0.6], s1}, 
          a2}, .5 {1, 1, 1}, {0, 0, 0}]}, #] &, grow1 tetv] // Normal;
  graphics3d = 
   Graphics3D[{s1, a3}, Boxed -> False, SphericalRegion -> True, 
    ViewAngle -> 0.2, ViewPoint -> {-1.5, -4, 0.2}, ImageSize -> 470, 
    PlotRange -> {{-0.4, 0.6}, {-0.56, 0.6}, {-0.3, 0.65}}]], {{grow1,
    0.5, "stage 1"}, 0.17, 0.5, 
  ImageSize -> Tiny}, {{grow2, 0.5, "stage 2"}, 0.17, 0.5, 
  ImageSize -> Tiny}, {{grow3, 0.5, "stage 3"}, 0.17, 0.5, 
  ImageSize -> Tiny}, "", "show tetrahedron", {{tetgr, 0.3, ""}, 0.3, 
  1, ImageSize -> Tiny}, ControlPlacement -> Left, 
 TrackedSymbols :> {grow1, grow2, grow3, tetgr}, 
 Initialization :> (tv = N[1/(2 Sqrt[6])];
   oct = PolyhedronData["Octahedron", "Faces"];
   s1 = scale[
     Rotate[Rotate[oct, Pi/4, {0, 0, 1}], 
       ArcTan[Sqrt[2]], {0, 1, 0}] // Normal, 0.5 {1, 1, 1}];
   tet = PolyhedronData["Tetrahedron", "Faces"];
   tetv = PolyhedronData["Tetrahedron", "VertexCoordinates"];)]

Mathematica graphics

The export seems to work fine now (as seen from Rhino3D). I chose DXF as format to get the colors across, but STL works as well, only without colors.

Mathematica graphics

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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