Tag Info

Hot answers tagged

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


9

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


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

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


7

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


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


6

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


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

Have try this following code. vertices1 = {{-1, -1, -1}, {-1, -1, 1}, {-1, 1, -1}, {-1, 1, 1}, {1, -1, -1}, {1, -1, 1}, {1, 1, -1}, {1, 1, 1}}; vertices2 = {{-(1/2), -(1/2), -(1/2)}, {5/6, -(7/6), 5/6}, {-(7/6), 5/6, 5/6}, {1/6, 1/6, 13/6}, {5/6, 5/6, -(7/6)}, {13/6, 1/6, 1/6}, {1/6, 13/6, 1/6}, {3/2, 3/2, 3/2}}; faces = {{5, 6, 8, 7}, {1, ...


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

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

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


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

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


2

OK, here's the code to do it. First, for completeness, your definitions: PHI=(1+Sqrt[5])/2; POINTS={{0, -1, -PHI}, {0, -1, +PHI}, {0, +1, -PHI}, {0, +1, +PHI}, {-1, -PHI, 0}, {-1, +PHI, 0}, {+1, -PHI, 0}, {+1, +PHI, 0}, {-PHI, 0, -1}, {+PHI, 0, -1}, {-PHI, 0, +1}, {+PHI, 0, +1}}; FACES={{1, 3, 11}, {1, 11, 6}, {1, 6, 4}, {1, 4, 10}, ...


2

EDIT Here's a slightly modified version of a suggestion made by Kuba in my separate question on this topic (coordinates[[1]] /. (Sqrt[5]) -> (2 tau - 1) // Simplify) /. tau -> HoldForm@\[Tau] ORIGINAL This is not the most elegant solution to grace this forum, but: Map[ If[ AtomQ@#, #, (Simplify[#/τ]*HoldForm@τ) /. { τ -> ...


2

As said in my comment, you need to specify which you want, as in: Graphics3D[{Opacity[1], FaceForm[Yellow], PolyhedronData[{"Dipyramid", 5}, "Faces"]}] You can query for details of available incarnations with: PolyhedronData["Dipyramid"] (* {{"Dipyramid", 3}, {"Dipyramid", 5}, "Octahedron"} *)


1

eps = 0.001; repl = (z_Symbol == val_) :> (val - eps/2 <= z <= val + eps/2); r1 = Line[{{0, 0}, {1, 0}}]; r2 = Line[{{1, 0}, {2, 0}}]; r3 = ImplicitRegion[RegionMember[ RegionUnion[r1, r2], {x, y}] // Simplify, {x, y}] /. repl ImplicitRegion[(x | y) \[Element] Reals && -0.0005 <= y <= 0.0005 && 0 <= x ...


1

Graphics3D[Normal@PolyhedronData["Dodecahedron", "Faces"] /. p : Polygon[__] :> {RandomChoice[{Red, White, Blue, Transparent}], p}, Lighting -> "Neutral"]



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