Tag Info

Hot answers tagged

13

Something like this perhaps: model = ExampleData[{"Geometry3D", "StanfordBunny"}]; region = BoundaryDiscretizeGraphics[model]; Rasterize @ RegionPlot3D[region, ColorFunction -> (Glow[GrayLevel[#3]] &), ViewPoint -> {0, 0, 10}, Background -> Black, Boxed -> False, Lighting -> None]


12

Here is a bit clumsy (had very little time) approach виа combination of new functionality Entity and regions. (* get the states *) divisions = EntityValue[Entity["AdministrativeDivision", {_, "UnitedStates"}], "Entities"]; (* get polygons of borders *) dat = EntityValue[ divisions, {"Population", "Polygon"}] /. {GeoPosition -> Identity, ...


12

Mostly the same as @SimonWoods, but it runs on V9: data = ExampleData[{"Geometry3D", "StanfordBunny"}, "VertexData"]; ListSurfacePlot3D[data, MaxPlotPoints -> 50, ColorFunction -> (Glow[GrayLevel[#3]] &), Mesh -> None, Background -> Black, Boxed -> False, ViewPoint -> {0, 0, 10}, Axes -> False]


7

This is a bug, I think, and I filed it as such: The second region should not evaluate to a RegionQ BoundaryMeshRegion. A BoundaryMeshRegion is valid if it contains a closed surface. The subtle point about BoundaryMeshRegion is that this closed surface is a (sparse) representation of the entire region the surface encloses. Why the first one does not work, I ...


6

Just add more PlotPoints: ContourPlot3D[1/(x^2 + y^2) - z == 0, {x, -1, 1}, {y, -1, 1}, {z, -150, 150}, PlotPoints -> 20]


5

Here's another approach : (* divide polygon pts to clean up artificials when polygon has holes *) FindContourBreaks[pts_List] := Module[{i, lines, breaks = {}}, lines = {pts[[#[[1]]]], pts[[#[[2]]]]} & /@ Partition[RotateLeft[Flatten[{#, #} & /@ Range[Length[pts]], 1]], 2]; Position[lines, Alternatives @@ ...


5

Like you, I found no colours in the output *.pov file. Mathematica recognises the pov extension, but Export["povtest.pov",pplot3D] outputs all triangle objects with white colour: pigment {color rgb <1, 1, 1>}. I took the brute-force approach and decomposed the 3D plot into vertices, triangles, and colours. Define the 3D plot. pplot3D = ...


5

SetOptions[{SphericalPlot3D, ParametricPlot3D}, Mesh -> None]; fun = {r {0, -Sin[t], Cos[t]}, r {Sin[t], 0, Cos[t]}}; p1 = SphericalPlot3D[{2, 2.5}, {u, 0, Pi}, {v, 0, 1.5 Pi}, PlotStyle -> Directive[Green, Opacity[0.7], Specularity[White, 20]]]; p2 = ParametricPlot3D[fun, {r, 2, 2.5}, {t, 0, Pi}, PlotStyle -> Directive[Green, ...


4

regionsandcolors = Thread[ {{(x <= 0 || y >= 0) && x^2 + y^2 + z^2 < 1, (x <= 0 || y >= 0) && 1 <= x^2 + y^2 + z^2 < 2, (x <= 0 || y >= 0) && 2 <= x^2 + y^2 + z^2 <= 3}, {Blue, Red, Green}}]; plots = RegionPlot3D[#1, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}, Mesh -> None, ...


4

Generally speaking Mathematica has 3D versions of everything, so you are probably best to use those from the start. But if you really want to convert 2D to 3D, then you could do it with a set of rules: Clear[linerule]; linerule[z_] := Line[points_, stuff___] :> Line[{First@#, Last@#, z} & /@ points, stuff]; Clear[textrule]; textrule[z_] := Text[t_, ...


4

First let's take a 3D element: g = PolyhedronData["Spikey"]; Export as GIF: As stated here one can Export a List of images as a GIF: animation = Table[Show[g, Boxed -> False, ViewVector -> {0, 5 Cos@u, 5 Sin@u}], {u, 0, Pi, Pi/20}]; Export["~/animated.gif", animation, "DisplayDurations" -> .1] giving: But since the question is ...


4

This is not a full solution, but here's a start. It would be useful if you could provide the grayscale and the overlaid coloured components separately because it looks like the grayscale part should control the opacity and the colours need to be added afterwards. Get the image: source = Import["http://i.stack.imgur.com/W76CQ.jpg"]; Reflect because we ...


4

The ability of adjusting the viewpoint and position of a model before obtaining its depth-map is necessary in most cases. By adopting the answers provided by the nice guys here, I obtained an alternative method in which the viewpoint and position of the model can be adjusted right before producing its depth-map. And function DiscretizeGraphics was used ...


4

Here is a way to do it: g1 = RevolutionPlot3D[{2 + Cos[t], Sin[t]}, {t, 0, 2 Pi}, PlotPoints -> 2]; surface = GraphicsComplex[g1[[1, 1]], {Opacity[0.7], g1[[1, 2, 1, 1, 5, 1]]}]; triangles = {Polygon[{{0, 0, 0}, {0, 2, 2}, {0, -1, 2}}], Polygon[{{2, 0, 0}, {2, 2, 2}, {2, -1, 2}}], Polygon[{{-3, 0, -3}, {3, 2, 2}, {-3, -1, 2}}], ...


3

I agree with @MichaelE2, 3D rendered tube will improve 3D notion by light reflection via Specularity and plus some Opacity. Manipulate[ lines = Table[{RandomInteger[{-1, 1}] a, RandomInteger[{-1, 1}] a, RandomInteger[{-1, 1}] a}, {2^a}]; Graphics3D[{Orange, Opacity[.3], Specularity[White, 20], Tube[lines, .05]}, Boxed -> False, Background ...


3

Let me shorten your example a little bit par = ParametricPlot3D[{1 + Cos[t], Sin[t], 2 Sin[t/2]}, {t, 0, 4 \[Pi]}, PlotStyle -> Red, Boxed -> False, AxesOrigin -> {0, 0, 0}, AspectRatio -> 1]; arr = Graphics3D[ { Arrowheads[0.02], {Red, Arrow[{a[0], a[0] + tf[0]}]}, {Green, Arrow[{a[1], a[1] + tf[1]}]}, {Blue, ...


2

The converstion between sparse arrays and graphs can be done with AdjacencyMatrix and AdjacencyGraph or IncidenceMatrix and IncidenceGraph. m = AdjacencyMatrix[GraphData["PappusGraph"]] AdjacencyGraph[m]


2

Since the bug doesn't seem to occur when the Inset contains a Row instead of a Column or Grid, one could define the following function: Attributes[fixInsets] = {HoldFirst}; fixInsets[plot_] := ReleaseHold[ Hold[plot] /. HoldPattern[Rule[Epilog, Inset[x_, y___]]] :> Rule[Epilog, Inset[Row[{x}], y]] ] Then use it on the faulty plots like ...


2

The bug is reproduced in v. 10.0.0 under Win7 x64. A workaround: Graphics[{Inset[Graphics3D[Sphere[], Axes -> True], Center, Center, Scaled[1]], Inset[Column[{"a"}], {.05, .05}]}]


2

While searching for a possible workaround I observed another strange behaviour: Only functions in V9 (ticks disappear in V10): Graphics3D[Sphere[], Axes -> True, Epilog -> Inset[Style["First row\nSecond Row", 12, Bold], {.05, .05}], ImagePadding -> 40] But this functions in both versions: Graphics3D[Sphere[], Axes -> True, Epilog ...


2

Here's a variation to help with different points of view. data = ExampleData[{"Geometry3D", "StanfordBunny"}, "VertexData"]; viewPoint = {-1, -1, -1}; {min, max} = {Min@#, Max@#} &@(EuclideanDistance[#, viewPoint] & /@ data) ListSurfacePlot3D[data, MaxPlotPoints -> 50, ViewPoint -> viewPoint, ColorFunction -> (Glow[GrayLevel[ (max - ...


2

Here is a different sort of answer, but very V10-style. The only logical expression however is Element, so I'm afraid this will fall short. Clear[regFn, regFn`mesh]; regFn`mesh[polyh_] := regFn`mesh[polyh] = ConvexHullMesh@PolyhedronData[polyh, "VertexCoordinates"] regFn[polyh_] := With[{region = regFn`mesh[polyh]}, {##} ∈ region &] This ...


2

I suppose they are nice....They check that a point is inside each facet plane. # -> PolyhedronData[#, "RegionFunction"] & /@ {"Octahedron", "Dodecahedron", "Icosahedron"} (* {"Octahedron" -> (2 (#1 + #3) <= Sqrt[2] + 2 #2 && 2 (#1 + #2 + #3) <= Sqrt[2] && 2 (#2 + #3) <= Sqrt[2] + 2 #1 && 2 #3 <= ...


1

First step is turning the GraphicsComplex in surface into standard Polygon-s: polys = surface // Normal // Flatten; I'll be using Resolve further on which doesn't like inaccurate numbers, so I Rationalize the coordinates. There are many coordinates that are terribly close to each other, leading to degenerated polygons. I'll remove these: polysClean = ...


1

Partly a response, You can work with Interactive Manipulation (just hit F1 and search for it) as well with Import and Export Animations (you know F1). m = Manipulate[Plot3D[Sin[x y + a], {x, 0, 6}, {y, 0, 6}], {a, 0, 4}] Export["manipulate1.avi", %] Works fine on Mac OS X x86 (64-bit) internals will translate "avi" to "mov".



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