Tag Info

New answers tagged

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


1

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


11

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]


11

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


4

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]


5

You've got a lot going on in your graphic that is possibly causing the slowdown. I have not done an exhaustive refactoring of your code, but hopefully considering this approach might help you. First, I pulled apart your graphic and tried to find what was slowing things down. The ParametricPlot3D has a greater effect on the performance than does the ...


1

As MichaelE2's comment there are a number of ways of generating the left figure. Using whubers circle function.: circle[x_, n_: 32] := {x + Cos[#], Sin[#], 0} & /@ Range[0, 2 \[Pi], 2 \[Pi]/n]; Graphics3D[{LightBlue, Tube[circle[#] & /@ Range[-2, 2, 2], 0.4]}, Boxed -> False] gives: Mark McClure's construction of a boxes six sides, ...


7

r = 1/40; sides = ParametricPlot3D[{ {0, u, v}, {1, u, v}, {u, 1, v}, {u,0,v} }, {u, 0, 1}, {v, 0, 1}, Mesh -> 7, PlotStyle -> { Directive[Purple, Opacity[0.6]], Directive[Purple, Opacity[0.6]], Directive[Purple, Opacity[0.6]], Directive[Purple, Opacity[0.2]] }, MeshStyle -> { Directive[Opacity[0.2]], ...


5

Here, I'll give an approximate solution also based on the Monte-Carlo approach but using very convenient functions introduced in V10. Here it is: pts = Import["https://dl.dropboxusercontent.com/u/68983831/npts.txt", "Table"]; polys = Import["https://dl.dropboxusercontent.com/u/68983831/npolys.txt", "Table"]; cpts = ...


4

This is in theory pretty simple. Think of it as two separated steps. First, you need function that models your extrusion-thickness, which has in the middle always the same value and at both ends it should round up like a circle. You can do this with Piecewise or, as I show here, with a combination of Heaviside functions: thicknessFunc[z_, body_] := ...


1

How about this. Generate a list of 2D points: pts = Table[{Cos[2 \[Pi] k/6], Sin[2 \[Pi] k/6]}, {k, 0, 6}]; ListLinePlot[pts] and we'll use a scaling function to form the caps. Plot[Sqrt[1 - (Abs@z - 1)^2], {z, -1, 1}, AspectRatio -> 1] sfunc[pt_] := Module[{z = Last@pt}, Piecewise[{{pt, -1 < Last@pt < 1}}, {{Sqrt[1 - (Abs@z - 1)^2], ...


7

Because when in Europe... Monte-Carlo! This should work with any shaped tube as long you are given the center points, and a certain resolution, in your case, should be the size of the polygon that make up the surface, or for example the minimum distance between point along the surface. Let's say that distance is dis. First we make a path along the inside ...


3

This might be a bit naive but if you are approximating a cylinder, why wouldn't you simply do the following? pts = Import["https://dl.dropboxusercontent.com/u/68983831/npts.txt", "Table"]; cpts = Import["https://dl.dropboxusercontent.com/u/68983831/cpts.txt", "Table"]; polys = Import["https://dl.dropboxusercontent.com/u/68983831/npolys.txt", "Table"]; fpts ...


2

In Version 10, we can compute the convex hull using ConvexHullMesh p = {{2, 1, 6}, {4, 3, 0}, {5, 2, 5}, {3, 5, 4}} chull = ConvexHullMesh[p] Which we can style using HighlightMesh Show[HighlightMesh[chull, Labeled[1, "Index"]], Graphics3D[{Red, Sphere[p, 0.1]}]]



Top 50 recent answers are included