I want to draw a set of convex polyhedrons whose vertices are defined by spherical coordinates on the surface of a unit sphere.

Currently I followed the advice from here: https://mathematica.stackexchange.com/a/21842/651 But it draws diagonals on any tetragonal face. Each face is composed of triangles. Is it possible to accomplish the same but without tetragonal faces diagonaled?

The current code:

verteces[n_]:=Flatten[Table [{1,Pi k/n, i 2Pi/Binomial[n,k]},{k,0,n},{i,0,Binomial[n,k]-1}],1]
Convex[n_]:=TetGenConvexHull[mapping/@ verteces[n]]
surface[n_] :=Last[Convex[n]]
Graphics3D[{Yellow,Opacity[.9],GraphicsComplex[pts[b],Polygon[surface[b]]], Black, Line[{{0,0,-1.1},{0,0,1.1}}]}]
  • 1
    $\begingroup$ Some code to show where you are at would be quite helpful. $\endgroup$ – Yves Klett Nov 26 '13 at 22:10
  • $\begingroup$ @Yves Klett I copied the code from the linked answer $\endgroup$ – Anixx Nov 26 '13 at 22:10
  • $\begingroup$ @Yves Klett I have added the current code. $\endgroup$ – Anixx Nov 26 '13 at 22:12
  • $\begingroup$ You can do this: take the triangle list surface[b]. Find the edges. Each edge has two neighbouring triangles. For each edge, if those two triangles are parallel (the dot product of their normals is 1 to a certain precision), merge them into a tetragon. Can you try to implement this? $\endgroup$ – Szabolcs Nov 26 '13 at 22:31
  • $\begingroup$ Quick fix would be to skip edges with: GraphicsComplex[pts[b], {EdgeForm[None], Polygon[surface[b]]}] $\endgroup$ – Kuba Nov 26 '13 at 22:32
<< ComputationalGeometry`
ComputationalGeometry`Methods`ConvexHull3D[mapping /@ verteces[5], 
                                           Axes -> None, Graphics`Mesh`FlatFaces -> False]

Mathematica graphics

Mapping over n (well, with a trick because it fails with more than three calculations in a row):

Mathematica graphics


merging with your code:

<< ComputationalGeometry`
mapping[{1, 0, 0}] = {0, 0, 1}
mapping[{1, Pi, 0}] = {0, 0, -1}
mapping := CoordinateTransformData[{"Spherical" -> "Cartesian"}, "Mapping"]
verteces[n_] := Flatten[Table[{1, Pi k/n, i 2 Pi/Binomial[n,k]}, {k,0,n}, {i, 0,Binomial[n,k]-1}], 1]

Graphics3D[{Yellow, Opacity[.9], 
           Sequence @@ ComputationalGeometry`Methods`ConvexHull3D[mapping /@ verteces[5], 
           Axes -> None, Graphics`Mesh`FlatFaces -> False],Black,Line[{{0, 0, -1.1}, {0, 0, 1.1}}]}]

Mathematica graphics

  • $\begingroup$ Magic again! +1 $\endgroup$ – PlatoManiac Nov 26 '13 at 23:27
  • $\begingroup$ While your result is great, I do not know how to implement it. Where should I put this function? $\endgroup$ – Anixx Nov 26 '13 at 23:28
  • $\begingroup$ @Anixx It's using your mapping and verteces :) just run it after your code $\endgroup$ – Dr. belisarius Nov 26 '13 at 23:32
  • $\begingroup$ How to use the result of this function? I tried to insert it in Graphics3D but it does not work $\endgroup$ – Anixx Nov 26 '13 at 23:33
  • $\begingroup$ Oh, I got it how. $\endgroup$ – Anixx Nov 26 '13 at 23:36

Here is another solution using coplanar triangles idea. Given six vertices of two triangles that share an adjacent edge, we use EigenValues to estimate the mean-square orthogonal distance of the points from the best fitting plane. In case it turns out to be close to zero we can assume the two triangles under consideration are coplanar with in some tolerance. You will find more details here. Once we know this for any two neighboring triangle in the TetGen mesh we can form a Quad by joining them.

trigToedge[list_] := Partition[list, 2, 1, 1]; 
Quad[current_, {pt_, tri_}] := 
 Block[{trigtopt, threeTigs, connectedTrigs, dist, mat, test,coplanar, edges},
  trigtopt[list_] := Extract[pt, Transpose@{list}];
  threeTigs = Select[tri, Length@Intersection[#, current] == 2 &];
  connectedTrigs = (trigtopt[#] & /@ threeTigs);
  dist = (
      mat = (# - Mean@#) & /@ (Transpose@(trigtopt[current]~Join~#));
      Min@Chop@Eigenvalues[(mat . Transpose@mat)/6]
      ) & /@ connectedTrigs;
  test = Position[dist, 0];
  {coplanar} = If[test != {}, Extract[threeTigs, test], {0}];
  If[Length@coplanar == 3, 
   edges = Cases[
     Tally[Join @@ (trigToedge /@ {current, coplanar}),
        (#1 == Reverse[#2] &)], {a_, 1} -> a];
   DeleteDuplicates@Flatten@Sort[edges, First@#2 == Last@#1 &], 


b = 9;
tri = surface[b];
pt = pts[b];
poly = Quad[#, {pt, tri}] & /@ tri;
Graphics3D[{GraphicsComplex[pt, Polygon[poly]], Black}, Boxed -> False, ImageSize -> 350]

enter image description here

As expected we have now the quads whenever they occur for odd b values. The current implementation is not optimal for very large meshes but the underlying mathematics is interesting!


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.