Tag Info

New answers tagged

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]


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


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


0

Thanks to Rahul Narain for pointing out my oversight, and thanks to Timothy Wofford for his suggestion. Here, I revised my code as below. I still keep on using the function DiscretizeGraphics because I can't get rid of the ugly boundaries produced by ListSurfacePlot3D. Code for viewpoint & position adjustment: model = Import["c:\\turtle.obj"]; vp = ...


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


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


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


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


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


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


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


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


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]


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]


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


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


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


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


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


6

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



Top 50 recent answers are included