Hot answers tagged

12

The short (and probably correct) answer is to download Mercury and get the CIF file from the Crystallograph Open Database. That way you can focus on your science and less on the, well fitting a square peg in a round hole. If you really want that square peg to fit in that round hole, however. First, recognize that Mathematica does not yet get a passing ...


10

Might as well... eorb = PlanetData["Earth", "OrbitPath"]; vorb = PlanetData["Venus", "OrbitPath"]; dl = DateRange[{2010, 1, 1}, {2015, 12, 31}, "Week"]; epos = Table[QuantityMagnitude[UnitConvert[ PlanetData["Earth", EntityProperty["Planet", "HelioCoordinates", {"Date" -> dates}]], ...


10

There is a problem with syntax in VertexRenderingFunction, can't explain more because I don't know what was the goal there. With[{ atoms = ChemicalData["Valeraldehyde", "VertexTypes"] } , GraphPlot3D[ ChemicalData["Valeraldehyde", "EdgeRules"], EdgeRenderingFunction -> ( { Specularity[White, 100], Cylinder[#1, .05] }& ...


10

Here's something that is nowhere near the sophistication of the original, but might get you started. The following assumes an orbital period for Venus of 225 days (thanks Michael!), and an average orbital distance from the sun of 0.72 AU (from very superficial Google searches). Table[ Module[ {venus, earth}, venus = 0.72 AngleVector[2 Pi/225 d]; ...


8

The problem with the GraphPlot is that you often get something that doesn't really resemble the molecule, it just has the right connectivity. First let's look at the example that is available in version 10, ChemicalData["VanadiumVOxide"] Obviously there is some data about atom positions, even if only in the 2D drawing. For the record, the 3D structure ...


7

There are 69,451 different polygons in the bunny, so that is why it takes so long to plot, so let's use a simpler example with only ~1,400 polygons: MeshVertices[mesh_] := First@Cases[mesh, GraphicsComplex[x_, __] :> x, Infinity] MeshFaces[mesh_] := Block[{faces}, faces = Cases[mesh, Polygon[x_, ___] :> x, Infinity]; If[faces == {}, ...


6

I did some time ago. tv = 225; te = 365.25; rv = 0.72; re = 1; e[t_] := {Cos[2 Pi t/te], Sin[2 Pi t/te]}; v[t_] := 0.72 {Cos[2 Pi t/tv], Sin[2 Pi t/tv]}; vis[t_, s_] := Graphics[ {Yellow, PointSize[0.05], Point[{0, 0}], White, Circle[{0, 0}, 1], Circle[{0, 0}, 0.72], Blue, PointSize[0.03], Point[v[t]], Red, Point[e[t]], White, ...


6

I'm not sure what kinds of calculations you'll want to do on the intersection line; but to get a sample of points on the intersection line, you could use DiscretizeRegion and MeshCoordinates: f[x_, y_, z_] = x^4 + y^4 + z^4 - 1; g[x_, y_, z_] = x - 2 y + z - 2; ContourPlot3D[{f[x, y, z] == 0, g[x, y, z] == 0}, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, ...


6

You may be looking for the option Appearance -> "Projected" which produces a different rendering: Graphics3D[{ Arrowheads[ConstantArray[0.05, 10], Appearance -> "Projected"], Arrow[{Cos[1 #] Sin[#], Sin[1 #] Sin[#], Cos[#]} & /@ Range[0, Pi, Pi/20]] }, BoxRatios -> 1 ] This does keep the arrow "in line" but the arrow will disappear ...


5

If you have OpenBabel installed, you can use its built-in structure optimization methods to generate 3D structures from SMILES structure format provided by Mathematica: Import["!obabel -:\"" <> ChemicalData["Valeraldehyde", "SMILES"] <> "\" -o xyz --gen3d --conformer --nconf 50 --score energy --weighted", "XYZ"] Unfortunately it does not ...


5

Raster3D just holds a matrix and an optional data range list, so you can get coordinate postions like this: raster = Raster3D[RandomReal[1, {3, 4, 5}], {{0, 0, 0}, {1,1,1}}]; dim = Dimensions@First@raster; coordinates = raster[[2]]; p = Position[First@raster, x_ /; x < .1]; pos = Reverse[coordinates[[1]] - Subtract @@ coordinates/dim #] & ...


5

With the caveat that it has zero physical meaning whatsoever, here you go: \[Omega]v = 365.25/225; rv = 0.72; lines = Table[Line[{{Cos[t], Sin[t]}, rv {Cos[\[Omega]v t], Sin[\[Omega]v t]}}], {t, 0, 20 \[Pi], \[Pi]/40}]; Graphics[{White, Opacity[0.4], lines, Opacity[1], Red, Circle[], Circle[{0, 0}, rv]}, Background -> Black] And if you want an ...


5

table = Table[Sin[j^2 + i], {i, 0, Pi, 0.1}, {j, 0, Pi, 0.1}]; Show[ListPlot3D[table], ListPlot3D[table, Filling -> 0, RegionFunction -> (#3 <= 0 &), FillingStyle -> Blue]]


4

Works for me with version 10.4.1 Show[Graphics3D[{(*Opacity[0],wholeregion,*)Red, Opacity[.5], lrectregion, Blue, Opacity[.5], rrectregion}, ImageSize -> Large], SliceVectorPlot3D[ gradField, {{y == ymidpt}, {z == zmidpt}}, {x, First@simxbds, Last@simxbds}, {y, First@simybds, Last@simybds}, {z, First@simzbds, Last@simzbds}, VectorPoints ...


4

Jason already said a lot of what I wanted to say, so I'll just offer this little snippet that avoids Normal[] chicanery: gc = ExampleData[{"Geometry3D", "StanfordBunny"}, "GraphicsComplex"]; Graphics3D[Insert[gc, EdgeForm[], {2, 1}] /. Polygon[m_?MatrixQ] :> Riffle[Table[RandomColor[], {Length[m]}], Polygon /@ m]] Just for variety, ...


4

See for a start Cardioid or Cardioid, Wiki. If i'm not mistaken this stuff is called Line Art, String Art and Curve Stitching. (Code Intellectual property of Matt Henderson of http://blog.matthen.com) Manipulate[Graphics[{Table[Line[{{Sin[a], Cos[a]}, {Sin[a + 2 Pi/3 + t], Cos[a + 2 Pi/3]}}], {a, 0, 2 Pi - 0.001, Pi/50}]}, PlotRange -> {{-1, 1}, {-1, ...


4

You can convert Raster3D into Image3D simply by applying Image3D and then use ImageValuePositions: whitePos = {1, 1, 1}; raster = Raster3D[ ReplacePart[RandomReal[1, {5, 5, 5, 3}], whitePos -> {1, 1, 1}]]; i3d = Image3D@raster xyz = ImageValuePositions[i3d, White] {{0.5, 0.5, 0.5}} PixelValuePositions[i3d, White] {{1, 1, 1}} As you ...


4

I'm always of the opinion that you should make a List of images that you then feed to ListAnimate rather than just giving the image function to Animate. The problem is how Animate deals with errors can really hog up your resources, and have it spitting out error messages all over the place. This is just a proof-of-principle, you will need to adjust it to ...


4

Say that list data contains triples of {latitude,longitude,altitude}. One possible visualisation uses ListPointPlot3D as follows. ListPointPlot3D[ data, Filling -> Bottom, BoxRatios -> {Automatic, Automatic, 0.04}, RotationAction -> "Clip", ColorFunction -> (ColorData["Rainbow", 2.5 (#3 - 0.6)] &)]


4

For version 9: f[x_, y_, z_] := x^3 + y^2 - z^2 g[x_, y_, z_] := x^2 + y^2 + z^2 - 1 cp3d = ContourPlot3D[{f[x, y, z]==0, g[x, y, z]==0}, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, BoundaryStyle -> {1 -> None, 2 -> None, {1, 2} -> {Thick, Red}}, ContourStyle -> Opacity[.7], Mesh -> None, ImageSize -> 400]; points = Cases[Normal@cp3d, ...


4

I agree on two counts: X3D is a logical export format, but Mathematica's X3D support is, at best, limited. Fortunately, the correspondence between Mathematica's GraphicsComplex and X3D is close enough that it is quite easy to roll your own exporter. To do so, let's begin with your own plot. We'll then extract out the primitives and directives that are ...


3

If you just want to make a plot of the region in question, this is good RevolutionPlot3D[{{x, (x + 8)^4}, {x, 8 x + 64}}, {x, -8, -6}, {th, 0, 2 π}, Mesh -> None, Axes -> False, Boxed -> False, BoxRatios -> {1, 1, .3}] But try as I might, I can't seem to find a way to get the volume of the region using Volume - this would involve ...


3

Here's a symbolic-algebraic way, based on the cylindrical algebraic decomposition (CAD) that Reduce computes. (* Disk/Washer method *) Clear[x, y, z]; eqns = {y == (x - 2)^4, 8 x - y == 16}; axis = x == 10; {depV} = Variables[Subtract @@ axis]; {indepV} = Complement[{x, y}, {depV}]; vars = {indepV, depV}; components = Map[ Reduce[#, vars] &, (* ...


3

Here are two additional approaches, one uses RegionIntersection, the other uses DiscretizeGraphics: f[x_, y_, z_] = x^4 + y^4 + z^4 - 1; g[x_, y_, z_] = x - 2 y + z - 2; regF = ImplicitRegion[f[x, y, z] == 0, {x, y, z}]; regG = ImplicitRegion[g[x, y, z] == 0, {x, y, z}]; reg = DiscretizeRegion @ RegionIntersection[regF, regG] MeshCoordinates @ reg // ...


3

Your problem was that your line did not depend upon $y$. ParametricPlot3D functions use both variables and produces fundamentally two-dimensional surfaces when you have two variables. ParametricPlot3D[{ {x, y, 2 Sin[x]}, {x, 2 + y/50, 2 Sin[x]} }, {x, 0, 3 π}, {y, 0, 6}, PlotStyle -> {{Opacity[0.5], Pink}, {Black}}] Best is to make the plot of ...


2

This is not entirely the same, as it changes coloring and z-scaling, but perhaps something similar may be of help. Essentially, the zero values are lifted by a small increment, while the original z-range is preserved. data = {{1, 1, 1, 1}, {1, 0, 3, 1}, {2, 0, 0, 1}}; ListPlot3D[data /. x_ /; x < .01 -> 0.01, Mesh -> None, InterpolationOrder ...


2

Try this With[{color = RGBColor[0.95, 0.93, 0]}, Show[ RegionPlot3D[ z <= -2 x^2 - 2 y^2 && z <= 8 x + y - 20, {x, -10, 10}, {y, -10, 10}, {z, -100, 0}, PlotStyle -> color, Mesh -> None], RegionPlot3D[ x^2 + y^2 <= 50, {x, -10, 10}, {y, -10, 10}, {z, -500, -100}, PlotStyle -> color, ...


2

I am not sure how well the following is answering your question. Here is the general idea: Write a function that finds distances from an arbitrary point to each of the lines defined by the polygons sides (line segments). Use some sort of dynamic manipulation to plot the most interesting point-segment distances. I assume it is important to stay in 3D, ...


2

Another possibility with GraphPlot3D (I also had to choose a different oxide because of missing data): {edges, elements} = ChemicalData["VanadiumVOxide", #] & /@ {"EdgeRules", "VertexTypes"}; coords = GraphPlot3D[edges][[1, 1, 1]]; colorRules = Thread[coords -> elements]; GraphPlot3D[edges, VertexRenderingFunction -> ({ColorData["Atoms"][#1 ...


2

SphericalPlot3D[se, {tt1, 0, Pi}, {tt2, 0, 2 Pi}, PlotStyle -> Directive[Red, Opacity[1]], PlotPoints -> 30, Boxed -> False, AxesOrigin -> {0, 0, 0}, AxesLabel -> {x, y, z}, TicksStyle -> Directive[FontOpacity -> 0, FontSize -> 0], AxesStyle -> Directive[Black, 12], Lighting -> "Neutral", Mesh -> {Range[-Pi, Pi , 2 ...



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