Hot answers tagged

33

Usage Just use this function with any polyhedron in in form: GraphicsComplex[pts_, Polygon[vertices_, ___]]. When I find time and motivation maybe I will add more DownValues so it can be more general. At the moment you can play with solids given by PolyhedronData[... "Faces"]: polyhedronRandomWalk[ PolyhedronData["DuerersSolid", "Faces"] ] ...


24

Intro This is completely different approach, since what we know about the net is not enough and the relation between faces and net faces isn't included, let's create the net from the polyhedron. The only issue with the present code is that the net is generated automatically and doesn't have to be the same as the one in PolyhedronData. The idea is to ...


19

[Edit: I found this method a rather pleasing application of analytic geometry, so I rewrote the explanation hopefully to do it justice. In fact, it can be applied in any dimension, and I've updated the code to be general] Here's my way: faces[simplex_] := Partition[simplex, Length@simplex - 1, 1, 1]; (* outward-oriented unit normals to each of ...


19

TL;DR; The mapping from "Icosahedron" faces' indices to net faces' indices is given by: {9 -> 10, 19 -> 20, 8 -> 19, 10 -> 17, 7 -> 9, 20 -> 8, 12 -> 18, 13 -> 15, 6 -> 7, 3 -> 6, 2 -> 16, 4 -> 13, 16 -> 5, 5 -> 4, 1 -> 14, 15 -> 11, 14 -> 3, 18 -> 2, 11 -> 12, 17 -> 1} but the answer isn't ...


17

Komei Fukuda researched the problem and developed a few nice software packages to address it and optimise the computation complexity. This answer uses Fukuda's codebase. Just to help understanding the non-triviality of the problem, here are a few simple but pathological cases and the debunking of two conjectures: Is every unfolding of a convex polytope ...


17

Edit: Recently Szabolcs released the new version of IGraphM (v0.2.0). Now the code below works pretty fine. Let us imagine that we move polyhedron faces a bit: name = "Icosahedron"; {poly, net} = PolyhedronData[name, {"Faces", "NetFaces"}]; Graphics3D[Normal@poly /. Polygon@pts_ :> Polygon@Transpose[.9 Transpose@pts + .1 Mean@pts]] Now we can ...


15

Update for v10 I used MeshRegion and MeshPrimitives for intersected points. linePoly[v1_, v2_, f_] := Module[{fC = Append[#, #[[1]]] & /@ f}, {x, y, z} /. NSolve[ Or@@ ({x, y, z}\[Element]# & /@ MeshPrimitives[MeshRegion[v1, Line /@ fC], 1]) && Or@@ ({x, y, z}\[Element]# & /@ MeshPrimitives[MeshRegion[v2, ...


15

InSphere[a_, b_, c_, d_] := Module[{cent, radius, tangents}, {cent, radius} = InSphere0[b - a, c - a, d - a]; cent = cent + a;(*Shift center back*) tangents = Map[Project[cent, #] &, {{a, b, c}, {b, c, d}, {c, d, a}, {d, a, b}}]; Return[{cent, radius, tangents}] ]; (*InSphere0[] assumes one vertex @origin*) InSphere0[a_, b_, ...


14

This may not be as neat as the other methods posted. About the only things I can say are that it is derived from basic principles, and it is fortunate that I had my hair buzzed rather short a few days ago. planePoly[verts_List, vars_List] := (vars - First[verts]).Cross @@ (First[verts] - #1 &) /@ Rest[verts] insideTet[faces_, pts_, verts_, pt_] ...


13

First, I defined dd as follows: dd = Entity["Polyhedron", "Dodecahedron"] (* regular dodecahedron *) Probing the properties of this Entity object, I can extract the vertex coordinates (I used Short here to truncate the output): dd["VertexCoordinates"]//Short (* {{-Sqrt[1+2/Sqrt[5]],0,Root[1-20 #1^2+80 #1^4&,3]},<<19>>} *) Now, I can use ...


12

Recently, I was finally able to read the wonderful book Matrices and Graphs in Geometry by Miroslav Fiedler. One of the things I learned from that book is that one can use the Cayley-Menger matrix not only for determining the volume of a simplex, but also for determining its circumsphere and insphere. What follows is a Mathematica implementation of Fiedler's ...


12

A convenient resource for the Miller Indices can be found here. This ref provides sufficient information for us to draw the (111) and (110) planes. First, reproduce the graphic from the demonstration. I just made the necessary changes to make it run outside of a Manipulate and did not try to optimize it. tet = PolyhedronData["Tetrahedron", "Faces"]; tetv ...


12

Exploit the fact that the vertices of the dual to a Platonic solid correspond to the centers of the faces of the solid itself. For instance, the dual to a cube is a regular octahedron, and the six vertices of this octahedron are in the directions of the centers of the faces of its dual cube. Find the normalized directions of the face centers of the cube ...


10

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}] & /@ ...


9

I might as well add that in version 10.2 you can use the built-in functions Insphere and Circumsphere to compute the insphere and circumsphere of a tetrahedron respectively. The output of both functions are Sphere objects which can be used in Graphics3D directly. So using the tetrahedron provided by the OP we can do: pts = {{0, 0, 0}, {1, 0, 0}, {2, 1, 0}, ...


9

Solution from @chuy looks really nice. Although I think that it was a little bit of work around because it's a visualization only, but the defined structure doesn't really represent the carved dodecahedron. Here is my approach of carving a dodecahedron pumpkin into pentagrams. First we define a function that makes a pentagram from a pentagon. tau = (2 ...


8

<< ComputationalGeometry` ComputationalGeometry`Methods`ConvexHull3D[mapping /@ verteces[5], Axes -> None, Graphics`Mesh`FlatFaces -> False] Mapping over n (well, with a trick because it fails with more than three calculations in a row): Edit merging with your code: << ...


8

I am glad that you are using Mathematica in your high school project. I think you forgot to mention in your question that the code you posted doesn't actually produce the image you showed; you may also want to mention where you obtained that image. Anyway, since your figure is made up of repeating units, I generated one unit, then translated it multiple ...


7

Graphics3D[ {GraphicsComplex[ Join[{Cos[#], Sin[#], 0} & /@ Range[0, 2 Pi, 2 Pi/(50)], {{0, 0, 1}}], {GeometricTransformation[Polygon[{##, 52} & @@@ Partition[Range[51], 2, 1]], {IdentityMatrix[3], ScalingTransform[{1, 1, -1}]}] }]}] Graphics3D[{GraphicsComplex[ Join[{Cos[#], Sin[#], 0} & /@ Range[0, ...


7

One way to approach this problem is through Tutte's spring embedding theorem. Pick one face as outer, embed the remaining graph in the planar region inside using Tutte's theorem, and then lift into 3D. Note that there is in general a continuum of polyhedra all of which realize the same polyhedral graph. This paper offers a new and simpler proof of Tutte's ...


7

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] ] Note the PlotPoints and the MaxRecursion ...


7

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


7

You can't get what you want with EdgeForm[Thickness[.03]], that's not what EdgeForm is meant for (that is, styles for the 1-dimensional edges). Here is a quick solution based on post-processing: Manipulate[ Normal[PolyhedronData["OctahedronThreeCompound", "Faces"]] /. p : Polygon[__] :> ( p /. pts : {{_?NumericQ, _, ...


6

styles = {MeshFunctions -> {#4/(Pi) &}, Mesh -> {Range[-1, 1, .05]}, BoundaryStyle -> Black, ImageSize -> 600, Boxed -> False, Axes -> False, PlotStyle -> Directive[Orange, Opacity[0.9], Specularity[White, 30]]}; ParametricPlot3D[{{v Sin[u], v Cos[u], v - 1}, {v Sin[u], v Cos[u], 1 - v}}, {u, -Pi, Pi}, {v, 0, ...


5

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


5

Invariant theory construction We can use Klein's invariants ($\Phi'$ on page 55, $H$ on page 61, Lectures on the Icosahedron) and project the complex roots onto the Riemann sphere, borrowing ubpdqn's projection code: tetraPoly = -z1^4 - 2 Sqrt[3] z1^2 z2^2 + z2^4; dodecaPoly = z1^20 + z2^20 - 228 (z1^15 z2^5 - z1^5 z2^15) + 494 z1^10 z2^10; (* project ...


5

Perhaps Lighting -> {{"Ambient", White}? Show[ PolyhedronData["Icosahedron"] /. Polygon[p_] :> MapIndexed[{Hue[Mod[3*First[#2], 20]/20], Polygon[#1]} &, p], Lighting -> {{"Ambient", White}} ]


4

Actually It turns out mathematica can nicely directly solve the posed system of quadratics... This should be equivalent to the formulation posed in the question: $Assumptions = {Element[x[i_, j_], Reals]} pts = Table[ x[i, j] , {i, 4}, {j, 3}] pts[[1]] = {0, 0, 1} pts[[2, 1]] = 0 soln = Solve[Simplify[(Norm[#]^2 == 1 & /@ pts)~Append~ (Equal @@ ...


4

A geometric construction The alternate vertices of a cube are the vertices of a regular tetrahedron. Rotate these about an appropriate axis (for an explanation of the mathematics, see, for example, Euclid, Prop. XIII.17 or this demonstration) five times through a 1/5 turn and you get the vertices of a regular dodecahedron. In the construction below, one ...


4

Oh hey, another chance to use my recent post. Define myRegionPlot3D from the linked answer, then do myRegionPlot3D[ Max[x + y + z, x - y - z, -x + y - z, -x - y + z] <= 2.75, (* tetrahedral truncation *) {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, Mesh -> 3] (* divide each square face into 4x4 squares *) Obviously there are ways to draw this ...



Only top voted, non community-wiki answers of a minimum length are eligible