New answers tagged

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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


0

To retain a 3D description of your graphics, you need to export to a 3D format. Mathematica has many built in exporters for 3D formats. The bigger problem is how to get PowerPoint to display and interact with the 3D object - it has no built-in capabilities to do so. The usual advice is to embed a CDF into a web page and display the web page in your slide ...


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


1

You can make an interpolating function from your data, that takes x, y, z as inputs and returns a color based on the matching value of n, colorfunc = Interpolation[{{#1, #2, #3}, #4} & @@@ Transpose[{x, y, z, n}], InterpolationOrder -> 1] ListPlot3D[Transpose[{x, y, z}], ColorFunction -> (ColorData[{"Rainbow", MinMax@n}][ ...


0

I'm not sure why InterpolationOrder -> 2 isn't working for you, but here is a work-around you might use. data = {{0, 0, 1738.946}, {0, 24, 1700.418}, {0, 48, 1698.078}, {32.05, 0, 1772.551}, {32.05, 24, 1736.689}, {32.05, 48, 1722.127}, {64.10, 0, 1999.362}, {64.10, 24, 1969.550}, {64.10, 48, 1919.607}}; plot1a = ListPointPlot3D[data, ...


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


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


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


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


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


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


1

Another way can be defining a single function f[x_, y_, z_] := If[z > 0, z - 50 <= -2 x^2 - 2 y^2, x^2 + y^2 <= 50] RegionPlot3D[f[x, y, z], {x, -10, 10}, {y, -10, 10}, {z, -50, 50}]


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


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

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



Top 50 recent answers are included