11
$\begingroup$

I'd like to plot something similar to this but with a triangle instead of a pentagon.

Also, I'd like to triangulate the faces, that is, to insert the diagonals for each face of the 3 prisms used.

In fact, I'd like to plot the minimal simplicial complex for the torus.

I tried to compute the vertices to use some polygon Plot3D function but no progress. Sorry.

torus

Edit:

Here is the code I have. I'm trying to see the 3 cycles to determine the faces. The problem is that they are not equilateral triangles.

pic3 = Graphics3D[{Green, 
   Polygon[{{0, -1, Sqrt[3] - 1}, {1, -1 - Sqrt[3], 
      Sqrt[3] - 2}, {-1, -1 - Sqrt[3], Sqrt[3] - 2}}]}]; 
pic2 = Graphics3D[{Pink, 
   Polygon[{{0, 0, 1}, {1, 0, Sqrt[3]}, {-1, 0, Sqrt[3]}}]}];
pic1 = Graphics3D[{Blue, 
    Polygon[{{0, 1, Sqrt[3] - 1}, {1, 1 + Sqrt[3], Sqrt[3] - 2}, 
             {-1, 1 + Sqrt[3], Sqrt[3] - 2}}]}];

my attempt

Edit 2:

Using some rotation transformation, I defined some points and rotated them to produce another triangles. The code below produces a better result.

Now I'd like to make it fancier, maybe with transparent or glass style.

triang1 = {{0, 0, 1}, {1, 0, 1 + Sqrt[3]}, {-1, 0, 1 + Sqrt[3]}};
triang2 = RotationTransform[2 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];
triang3 = RotationTransform[4 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];

pic1 = Graphics3D[{Blue, Polygon[triang1]}];
pic2 = Graphics3D[{Red, Polygon[triang2]}];
pic3 = Graphics3D[{Green, Polygon[triang3]}];

trapez1 = {triang1[[1]], triang2[[1]], triang2[[2]], triang1[[2]]};
Gtrapez1 = Graphics3D[{Yellow, Polygon[trapez1]}];
trapez2 = {triang1[[1]], triang3[[1]], triang3[[2]], triang1[[2]]};
Gtrapez2 = Graphics3D[{Yellow, Polygon[trapez2]}];
trapez3 = {triang3[[1]], triang2[[1]], triang2[[2]], triang3[[2]]};
Gtrapez3 = Graphics3D[{Yellow, Polygon[trapez3]}];
trapez4 = {triang1[[1]], triang2[[1]], triang2[[3]], triang1[[3]]};
Gtrapez4 = Graphics3D[{Yellow, Polygon[trapez4]}];
trapez5 = {triang1[[1]], triang3[[1]], triang3[[3]], triang1[[3]]};
Gtrapez5 = Graphics3D[{Yellow, Polygon[trapez5]}];
trapez6 = {triang3[[1]], triang2[[1]], triang2[[3]], triang3[[3]]};
Gtrapez6 = Graphics3D[{Yellow, Polygon[trapez6]}];

Show[Gtrapez6, Gtrapez5, Gtrapez4, Gtrapez3, Gtrapez2, Gtrapez1,
     pic1, pic2, pic3, Boxed -> False, AspectRatio -> Automatic]

my second attempt

Improve this question
$\endgroup$
0

4 Answers 4

Reset to default
12
$\begingroup$

Update 2: A function to generate tori:

 toroidalF[n_, h_: (1/4), w_: (1/2), opts : OptionsPattern[]] :=
   Module[{top, bottom, verts,
           outer = {Cos[#], Sin[#], 0} & /@ Range[0, 2 Pi, 2 Pi/n],
           faceverts = Flatten[#[[{1, 2, 4, 3}]] & /@ # & /@
                            (Join @@@ Subsets[#, {2}] & /@ 
                               Thread[{#, # + n + 1, # + 2 n + 2} &@
                                  Partition[Range[n + 1], 2, 1]]), 1]},
          top = # + {0, 0, h} & /@ (w outer);
          bottom = # + {0, 0, -h} & /@ (w  outer);
          verts = Join[outer, top, bottom];
          Graphics3D[{Opacity[.5], EdgeForm[], 
                      GraphicsComplex[verts, Polygon /@ faceverts]}, opts]]

Examples:

 Row[toroidalF[#, Boxed -> False, ImageSize -> 250] & /@ {3, 4, 5, 6}]

enter image description here

 Row[toroidalF[#, 1/5, 3/4, Boxed -> False, ImageSize -> 250] & /@ {3, 6, 9, 12}]

enter image description here

Stealing @Junho Lee's lighting l:

 Row[toroidalF[#, Boxed -> False, ImageSize -> 250, Lighting -> l] & /@ {3, 4, 5, 6}]

enter image description here

A brute-force approach to get the torus

 outer = {Cos[#], Sin[#], 0} & /@ Range[0, 2 Pi, 2 Pi/3];
 top = # + {0, 0, 1/4} & /@ (.5 outer);
 bottom = # + {0, 0, -1/4} & /@ (.5 outer);
 verts = Join[outer, top, bottom];
 faceverts = Flatten[#[[{1, 2, 4, 3}]] & /@ # & /@ 
                 (Join @@@ Subsets[#, {2}] & /@
                   Thread[{#, # + 4, # + 8} &@Partition[Range[4], 2, 1]]), 1];
 polygons = Polygon /@ faceverts;
 Graphics3D[{Opacity[.5], EdgeForm[], GraphicsComplex[verts, polygons]}, 
            Boxed -> False, ImageSize -> 600]

enter image description here

Update: Triangulation of rectangular faces:

faceverts2 = Join @@ (Join @@@ Subsets[#, {2}] & /@ 
                  Thread[{#, # + 4, # + 8} &@Partition[Range[4], 2, 1]]);
triverts = Flatten[{#, RotateLeft@#} & /@ faceverts2, 1][[All, ;; 3]];
polygons2 = Polygon /@ triverts;
Graphics3D[{Opacity[.5], GraphicsComplex[verts, polygons2]},
           Boxed -> False, ImageSize -> 600]

enter image description here

Triangulation of faces using V10 on Wolfram Programming Cloud:

rR = BoundaryMeshRegion[verts, polygons];
HighlightMesh[rR,
      {Style[2, Directive[Opacity[.5],LightBlue]] ,Style[1,Directive[Thick,Blue]]}]

enter image description here

tm= TriangulateMesh[rR, MaxCellMeasure -> \[Infinity], MeshQualityGoal->"Minimal"];
HighlightMesh[tm, 
        {Style[2, Directive[Opacity[.5],LightBlue]],Style[1, Directive[Thick,Blue]]}]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ Ow, very nice! Thanks. I have no idea about the code but it is pretty. $\endgroup$
    – Sigur
    Aug 21, 2014 at 3:32
  • $\begingroup$ What a marvelous update! $\endgroup$
    – Sigur
    Aug 21, 2014 at 18:14
  • $\begingroup$ Does your first block of code work on V9? I'm getting Coordinate {ImageSize -> 250, 0, Boxed -> False} should be a triple of numbers, or a Scaled form. $\endgroup$
    – Sigur
    Aug 22, 2014 at 23:55
10
$\begingroup$

This can also be done with the built-in plotting functions, e.g.

RevolutionPlot3D[
                 {2 + Cos[t], Sin[t]},
                 {t, 0, 2 Pi},
                 PlotPoints -> {4, 4}, MaxRecursion -> 0,
                 Mesh -> All,
                 PlotStyle -> Opacity[.2]
                ]

triangular torus

Note the PlotPoints and the MaxRecursion options.

Improve this answer
$\endgroup$
2
  • $\begingroup$ amazing!!! +++1 $\endgroup$
    – kglr
    Sep 22, 2014 at 21:25
  • $\begingroup$ @kguler Have been always using this trick to generating meshes :) $\endgroup$
    – Silvia
    Sep 22, 2014 at 21:56
9
$\begingroup$

Update: From your intuitive code

Step 1 I deleted color of polygon in your code like this.

triang1 = {{0, 0, 1}, {1, 0, 1 + Sqrt[3]}, {-1, 0, 1 + Sqrt[3]}};
triang2 = RotationTransform[2 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];
triang3 = RotationTransform[4 Pi/3, {1, 0, 0}, {0, 0, 0}][triang1];

pic1 = Graphics3D[{Polygon[triang1]}];
pic2 = Graphics3D[{Polygon[triang2]}];
pic3 = Graphics3D[{Polygon[triang3]}];

trapez1 = {triang1[[1]], triang2[[1]], triang2[[2]], triang1[[2]]};
Gtrapez1 = Graphics3D[{Polygon[trapez1]}];
trapez2 = {triang1[[1]], triang3[[1]], triang3[[2]], triang1[[2]]};
Gtrapez2 = Graphics3D[{Polygon[trapez2]}];
trapez3 = {triang3[[1]], triang2[[1]], triang2[[2]], triang3[[2]]};
Gtrapez3 = Graphics3D[{Polygon[trapez3]}];
trapez4 = {triang1[[1]], triang2[[1]], triang2[[3]], triang1[[3]]};
Gtrapez4 = Graphics3D[{Polygon[trapez4]}];
trapez5 = {triang1[[1]], triang3[[1]], triang3[[3]], triang1[[3]]};
Gtrapez5 = Graphics3D[{Polygon[trapez5]}];
trapez6 = {triang3[[1]], triang2[[1]], triang2[[3]], triang3[[3]]};
Gtrapez6 = Graphics3D[{Polygon[trapez6]}];

Step 2 And I combined Graphics3D-s like following

graphics = {Gtrapez6, Gtrapez5, Gtrapez4, Gtrapez3, Gtrapez2, 
    Gtrapez1, pic1, pic2, pic3} /. Graphics3D -> Identity;

Graphics3D[graphics]

Blockquote

Step 3 I add lighting by using Lighting in the Graphics3D

A = RotationTransform[2 \[Pi]/3, {0, 0, 1}];
lp = {2, 1, 2};
l = {{"Point", Blue, lp},
   {"Point", Red, A@lp},
   {"Point", Green, A@A@lp}};

Graphics3D[{Opacity[0.4], graphics},
 Boxed -> False, Lighting -> l]

Blockquote

---------------------------------------------------------------------

Last: General Code

Step1

I have made Torus like this 

A = RotationTransform[2 \[Pi]/3, {0, 0, 1}];
vertex =
  Flatten[
   NestList[A, #, 2] & /@ {{1, 0, 1/2}, {5/2, 0, 0}, {1, 0, -1/2}}, 1];
poly =
  Flatten /@ (Flatten[
      Transpose /@ Partition[
        Partition[#, 2, 1, 1] & /@ Partition[Range[9], 3], 2, 1, 1]
      , 1] /. {a_, b_} :> {a, Reverse@b});

Step2

Use Lighting options in the Graphics3D.

lp = {3, 0, 0};
l = {{"Point", Red, lp},
   {"Point", Green, A@lp},
   {"Point", Blue, A@A@lp}};
Graphics3D[GraphicsComplex[vertex,
  {Opacity[0.3], Specularity[Orange, 50], Polygon /@ poly}],
 Boxed -> False, Lighting -> l]

Blockquote

An other light position

lp = {3, 2, 2};
l = {{"Point", Blue, lp},
   {"Point", Red, A@lp},
   {"Point", Green, A@A@lp}};
Graphics3D[GraphicsComplex[vertex,
  {Opacity[0.3], Specularity[Orange, 50],
   EdgeForm[Thin], Polygon /@ poly}],
 Boxed -> False, Lighting -> l]

Blockquote

Improve this answer
$\endgroup$
2
  • $\begingroup$ Very beautiful view. Nice light also. Thanks so much. Unfortunately I'm not able to follow the code. As you see, my updated code is made by very intuitive pieces. $\endgroup$
    – Sigur
    Aug 21, 2014 at 18:15
  • 1
    $\begingroup$ @Sigur I modified the code for understanding of you from your intuitive pieces. I hope this is helpful for you. $\endgroup$
    – Junho Lee
    Aug 22, 2014 at 0:09
3
$\begingroup$

Here is my own variation, which uses a modernized version of Roman Maeder's MakePolygons[]:

MakePolygons[vl_] /; ArrayQ[vl, 3] := Module[{dims = Most[Dimensions[vl]]}, 
  GraphicsComplex[Apply[Join, vl], Polygon[Flatten[Apply[Join[#1, Reverse[#2]] &, 
                  Partition[Partition[Range[Times @@ dims], Last[dims]], {2, 2}, {1, 1}],
                        {2}], 1]]]]

With[{n = 6, m = 3, c = 3, r = 1}, 
     Graphics3D[MakePolygons[ArrayPad[Map[Function[pt, Append[#1 pt, #2]],
                                          CirclePoints[n]] &
                                      @@@ (TranslationTransform[{c, 0}] /@
                                     (CirclePoints[{r, 0}, m])), {{0, 1}, {0, 1}},
                                     "Periodic"]]]]

triangulated torus

Improve this answer
$\endgroup$

Your Answer

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

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