Tag Info

Hot answers tagged

16

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


14

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


13

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


12

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

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


11

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


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


10

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


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

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

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

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

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

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


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


6

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


5

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


5

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


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


4

Here's a way to number the faces completely within Mathematica. Most of the information about polyhedra needed for this is already in Mathematica in PolyhedronData. If you do not have V10, then Needs["GeneralUtilities`"] may be omitted and Where replaced with CompoundExpression. Opposite faces are identified by their centroids having coordinate that are ...


4

Using @MichaelE2's example, a combination of Glow and Lighting->None produces a similar picture: Show[PolyhedronData["Icosahedron"] /. Polygon[p_] :> MapIndexed[{Glow[Hue[Mod[3*First[#2], 20]/20]], Polygon[#1]} &, p], Lighting -> None] Alternatively: A surface can be specified as having an absolute color col by giving the ...


4

Instead of using cddlib you can use the nicely packaged version in polymake, which certainly installs without problems on OS X, and you can just call by an external function call from Mathematica (no mathlink interface necessary). polymake has a lot of other functionality too.


4

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 direction of the centers of the faces of its dual cube. Find the normalized directions of the face centers of the cube ...


4

You can make your own satan-worshiping dodecahedron by using texture. The following is more-or-less based on a Neat Example in the Texture documentation. First, download your favourite evil pentagram image: im = Import["http://vignette1.wikia.nocookie.net/sonicfanchara/images/9/9c/\ Goth-pentagram-devil.gif/revision/latest?cb=20131018174814"]; Then ...


3

gr = Show[PolyhedronData["Dodecahedron"], Boxed -> False, ImageSize -> 400]; gr2 = gr /. Polygon[x_] :> Polygon[#[[{1, 3, 5, 2, 4}]] & /@ x]; Row[{gr, gr2}]


3

polyhed = PolyhedronData["Dodecahedron", "Polyhedron"]; coords = PolyhedronData["Dodecahedron", "VertexCoordinates"]; lines = Graphics3D[Line[Tuples[coords, 2]]]; Show[polyhed, lines] This is a bit of a cheat, since it actually draws lines connecting all pairs of points on the dodecahedron (take a look at the lines object I define in the code); it's ...


3

PolyhedronData["Icosahedron", "VertexCount"] == Length@v (* False*) Yours isn't an Icosahedron However, it's a Dodecahedron instead: f = Nearest@v Graphics3D[Line /@ Flatten[MapThread[List, {f[#, 4], ConstantArray[#, 4]}] & /@ v, {2}]] V10 BoundaryMeshRegion[ ConvexHullMesh[v], MeshCellStyle -> {0 -> {PointSize@.02, Blue}, 1 -> ...


3

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


3

It can in principle be done using RegionPlot3D. But to get sharp edges, one needs to crank up the number of PlotPoints. Here is an example with four cubes that doesn't take too long to plot: n = 4; insideCube[pt_, l_] := And @@ Thread[Abs[pt] < l] rotations = MapThread[ RotationMatrix[{{0, 0, 1}, {Cos[#1] Sin[#2], Sin[#1] Sin[#2], Cos[#2]}}] ...


3

This takes some time for pre-processing: h1 = Hexahedron[{{-1.1666666666666667`, 0.8333333333333334`, 0.8333333333333334`}, {0.16666666666666666`, 2.1666666666666665`, 0.16666666666666666`}, {1.5`, 1.5`, 1.5`}, {0.16666666666666666`, 0.16666666666666666`, 2.1666666666666665`}, {-0.5`, -0.5`, -0.5`}, {0.8333333333333334`, ...



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