Hot answers tagged

14

One way is to compute the solid angle subtended by the cow viewed at the point by summing signed solid angles corresponding to the cow's polygonal faces. If the total is 4 pi, the point is inside the cow; if 0, outside. Background Quoting Wikipedia, "Solid angle is the two-dimensional angle in three-dimensional space that an object subtends at a point." ...


12

This is basically a rehash of code I posted in a prior thread on this topic. The underlying method is to shoot a ray from the point and see how many surface triangles it intersects. elsie = ExampleData[{"Geometry3D", "Cow"}]; verts = First[Cases[elsie, GraphicsComplex[a_, ___] :> a, Infinity]]; pgons = First[Cases[elsie, Polygon[x_, ___] :> x, ...


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

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


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


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

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


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


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


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

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


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


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

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

You can convert Raster3D into Image3D simply by applying Image3D and then use ImageValuePositions: whitePos = {1, 2, 3}; raster = Raster3D[ ReplacePart[RandomReal[1, {5, 5, 5, 3}], whitePos -> {1, 1, 1}]]; i3d = Image3D@raster xyz = ImageValuePositions[i3d, White] {{2.5, 1.5, 0.5}} PixelValuePositions[i3d, White] {{3, 2, 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

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


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

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

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


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

You can also use the options Mesh and MeshFunctions with a single ParametricPlot3D: a = 2; b = 2 Pi; ParametricPlot3D[{u, v, 2 Sin[u]}, {u, 0, 3 Pi}, {v, 0, 6}, MeshFunctions -> {# &, #2 &, ConditionalExpression[#2 - 2, a <= # <= b] &}, Mesh -> { 15, Range[0, 6, .5], {{0, Directive[Thick, Red]}}}]


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

Perhaps this solution, which uses Tooltip, will work for you. I prefer this approach because it is simple and minimizes clutter in the plot. data = {{0.000, 0.000, 0.000}, {-1.612, 8.077, -2.474}, {-19.599, 186.849, -246.583}, {-29.000, -19.499, 12.157}, {-1.646, -1.375, -3.842}, {3.127, -19.235, 15.660}, {167.744, 834.512, -122.686}, {-5.353, ...


2

You will want to set the automatic rescaling of the data passed to ColorFunction, then write your own ColorFunction that appropriately rescales the data so that a $z$ value of 25 is translated to an input of $0.5$ to the TemperatureMap color function: ParametricPlot3D[ yourFunction, yourParamValues, ColorFunctionScaling -> False, ColorFunction ...


1

labels = {"Sun", "Sirius", "Canopus", "Arcturus", "Rigil K", "Vega", "Rigel", "Procyon", "Betelgeuse", "Bellatrix", "Capella", "Aldebaran", "Antares", "Pollux", "Castor", "Regulus", "VY Canis M", "Proxima C", "Barnard", "Wolf 359", "Lalande 21185", "Ross 154", "Epsilon Eri", "Tau Ceti", "Kruger 60", "Gliese 876", "55 Cancri", "61 ...



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