New answers tagged

0

Example Description This can be achieved using PlotRange -> {{xmin,xmax},{ymin,ymax},{zmin,zmax}}, you can use Automatic as an argument to let Mathematica decide what is min or max. For example, PlotRange -> {Automatic, Automatic , {1,Automatic}} Code m = 1; q = 5/2; K = Sqrt[4 m/(3 - q)]; \[Xi] = (q - 1)^2/4 K^2; A = Pi/Sqrt[\[Xi]]; Plot3D[ 1/A (...


2

The problem is plot quality, not the code. The answer is MaxRecursion ParametricPlot3D[{I01[x, y], I11[x, y], I02[x, y]}, {x, 0, 8 \[Pi]}, {y, 0, 8 \[Pi]}, MaxRecursion -> 5]


0

This should work: g = {g0, g1, g2, g3, g4}; s = {S0, S1, S2, S3, S4}; Animate[Labeled[Graphics3D[g[[i]], ViewPoint -> Front], s[[i]],Top], {i, 1, 5, 1}, AnimationRunning -> False,PreserveImageOptions -> False]


0

I think what you are asking is a default feature. For example ListAnimate[Table[Graphics3D[{Hue[x], Cuboid[]}], {x, 0, 1, .01}]] If you pause it, rotate the Cuboid and then play again, you will see that it will resume its initial position.


0

Marsaglia's method: uniform on disk (here rejection method), transform by Lambert azimuthal equal-area projection: http://mathworld.wolfram.com/SpherePointPicking.html uniformDisk[n_] := Take[Select[Table[RandomReal[{-1, 1}], {3 n}, {2}], #.# <= 1 &], n]; diskToSphere[p_] := {2 p[[1]] Sqrt[1 - Dot[p, p]], 2 p[[2]] Sqrt[1 - ...


0

You could use ListDensityPlot3D for visualization purposes instead. This also has the useful option "OpacityFunction"... IMO, you could also use Image3D and rescale the data only for display purposes. You can work with Image3D's with colors that are out-of-0-1-range just fine, they just don't display correctly. (*Data*) normalizedVolumeData = {{{0, 0, 0}, {...


5

You could create a region using DiscretizeGraphics and find points within a certain distance of the surface using RegionDistance g = Normal @ Plot3D[x^2 - y^2, {x, -1, 1}, {y, -1, 1}]; f = RegionDistance @ DiscretizeGraphics @ g; data = Array[f[{##}] &, {60, 60, 60}, {-1.1, 1.1}]; Image3D[Clip[data, {0.05, 0.05}, {1, 0}]]


0

For Graphics3D -> Image3D: This answer: http://mathematica.stackexchange.com/a/33277/6804 gives an approach that rasterizes individual 2D slices at different heights and stacks them into a 3d image. Of course you need to select a resolution, the conversion will not be lossless in general (and I don't know what would happen when the Graphics3D object is a ...


0

This answer: http://mathematica.stackexchange.com/a/33277/6804 gives an approach that rasterizes individual 2D slices at different heights and stacks them into a 3d image.


3

For an approximately even distribution of points on any surface with cylindrical symmetry, we can use the Golden Angle, the same way that the sunflower uses it on the plane. To place N points on the surface of a sphere, define an axis. Divide the surface into N equal area strips perpendicular to the axis. For k in 0 to N-1, on the kth strip, place a point ...


3

test = points[70]; With somewhat equally spaced points on the sphere from this answer. Graphics3D[{Sphere[], test /. r : {x_, y_, z_} :> Cone[{.95 r, 1.25 r}, .1]}, ImageSize -> Medium, Boxed -> False]


4

With[{n = {3, 4, 5, 6, 7, 20}}, Partition[show[points[#]] & /@ n, 3]] // GraphicsGrid With the code below, with piecewise spring forces (exclusively repulsive) and Cartesian vectors. A different model for force and switch to spherical vectors would probably be wise. show[points_] := Graphics3D[{ Opacity[.5], Sphere[], Opacity[1], PointSize[...


4

Tricks to my mind,Suppose your version is 10.2 or later,although I don't sure you will like Show[SliceContourPlot3D[#, "CenterPlanes", {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, ContourShading -> White] & /@ {x, y, z}, Axes -> True, Boxed -> False, AxesOrigin -> {0, 0, 0}]


7

Aha~ I suppose this question is created while solving this. Am I correct @yode :P So here's an easy solution, simple, elegant, and may I say even quite fast after some optimization? pt = With[{p = Table[{x[i], y[i], z[i]}, {i, 80(*number of charges*)}]}, p /. Last@ NMinimize[ Total[1/Norm[Normalize[#1] - Normalize[#2]] & @@@ ...


12

A mathematical approach using $A_\text{g}$ irreps of $I_h$ symmetry group expressed in terms of spherical harmonics. First some data l[1] = 6; mlist[1] = {-5, 0, 5}; slist[1] = {Sqrt[7]/5, Sqrt[11]/5, -(Sqrt[7]/5)}; l[2] = 10; mlist[2] = {-10, -5, 0, 5, 10}; slist[2] = {Sqrt[187/3]/25, -(Sqrt[209]/25), Sqrt[247/3]/25, Sqrt[ 209]/25, Sqrt[187/3]/25}; l[...


4

Well, maybe you can make something with this? a1 := SliceContourPlot3D[z, x == 0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, Background -> Black, ContourShading -> White, Contours -> 9, TicksStyle -> {Red, Green, Blue}] a2 := SliceContourPlot3D[z, y == 0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, ContourShading -> White, Contours -> 9] ...


24

This is probably too slow to get a decent image, but here's a simple attempt. As JM suggests, you can use Geodesate to get a good set of points on the sphere. I used ContourPlot3D to plot a sphere whose radius increases in the vicinity of one of those points. Needs["PolyhedronOperations`"] pts = Geodesate[PolyhedronData["Icosahedron"], 2][[1, 1, 14 ;;]]; ...


12

If more ad hoc, inexact approaches are welcome, one way to generate relatively uniform density of points on a sphere is to use Monte Carlo Lloyd's algorithm (modified for the spherical case): With[{points = 200, samples = 40000, iterations = 20}, Nest[With[{randoms = Join[#, RandomPoint[Sphere[], samples]]}, Table[Normalize@Mean@Extract[randoms, ...


6

Correct me if I'm wrong... but I suppose, pedantically speaking, there are only five solutions defined by Platonic solids, and trivial solutions for 0-3 points (extension of CirclePoints). Thus: ClearAll[spherePoints]; spherePoints[r_: 1, n_ /; 0 <= n < 4] := {##, 0} & @@@ CirclePoints[r, n]; (spherePoints[r_: 1, PolyhedronData[#, "VertexCount"]...


2

For points uniformly spaced in angular variables, you can use CirclePoints. spherepoint[m_, n_] := Union@Flatten[Table[Join[{Cos[q]}, Sin[q] #] & /@ CirclePoints[n], {q, 0, Pi, Pi/m}], 1] ListPointPlot3D[spherepoint[20, 30], BoxRatios -> 1] For uniformly spaced in Cartesian coordinates, things would be complicated. The ...


4

Here is an answer to this question derived from its comments. Currently there is no way to preserve the interactive capabilities of a 3D plot when using Export. If it is not possible to do the presentation with Mathematica itself, perhaps by using its slideshow capability, the next best recourse is to put the 3D plot in a CDF document and present it with ...


1

Why not go to the WRI demo site and search for demos involving the Dandelin spheres? You can download the source code and see how some others did it. For example: http://demonstrations.wolfram.com/DandelinSpheresForAnEllipse/


3

Here's a starting point. Figuring out what I exactly did is left as an exercise. With[{r = 5/2, φ = π/4, s1 = 3/4, s2 = 3/2}, Graphics3D[{{Directive[CapForm[None], Opacity[2/3]], Tube[{{0, 0, -r Cot[φ/2]}, {0, 0, 0}, {0, 0, r Cot[φ/2]}}, {r, 0, r}]}, {Sphere[{0, 0, s1 Csc[φ/2]}, s1], Sphere[{0, 0, -s2 Csc[φ/2]}, s2]}, ...


2

As noted in the docs, the only effect of specifying VertexNormals is in the shading; recall that Mathematica uses the Phong model for depicting surfaces. The docs also have a review of how shading is done in Mathematica. For further illustrations, here is a modified version of your demonstration function g: g[p_, nl_, opts___] := Graphics3D[{FaceForm[...


28

Here's my attempt at a soccer/foot ball, updated with an improved surface model: First create the patches (code below): pl /@ {5, 6} Then stitch them together using FindGeometricTransform to help with the work. The patches are made using NDSolve and simple PDE over a polygonal region. (Pretty cool, I thought.) Then they have to be sized and "...


3

The documentation for RegionPlot3D states You should realize that since it uses only a finite number of sample points, it is possible for RegionPlot3D to miss regions in which pred is True. To check your results, you should try increasing the settings for PlotPoints and MaxRecursion. This is what happened in your second example, a result of the region ...


15

The approach that David took here can be reused in this context like so: vertices[faceIndex_] := N@Part[ PolyhedronData["TruncatedIcosahedron", "VertexCoordinates"], PolyhedronData["TruncatedIcosahedron", "FaceIndices"][[faceIndex]] ] rf[faceIndex_] := Module[{cp}, cp = Cross @@@ Partition[vertices[faceIndex], 2, 1, {1, 1}]; Function[{x, y, z},...


23

I am not sufficiently skilled to be able to fake the ridges along each polygon, so here is my modest attempt: arc[center_?VectorQ, {start_?VectorQ, end_?VectorQ}] := Module[{ang, co, r}, ang = VectorAngle[start - center, end - center]; co = Cos[ang/2]; r = EuclideanDistance[center, start]; BSplineCurve[{start, center + r/co Normalize[(start + ...


16

Below I'll use @J.M. convenient arc function from his answer to this question: Clear[arc] arc[center_?VectorQ, {start_?VectorQ, end_?VectorQ}] := Module[{ang, co, r}, ang = VectorAngle[start - center, end - center]; co = Cos[ang/2]; r = EuclideanDistance[center, start]; BSplineCurve[{start, center + r/co Normalize[(start + end)/2 - center], end}, ...


5

A possible workaround (brought up by the Wizard in the comments) involves the use of some of the functions from this previous answer. In particular, you will need orthogonalDirections[], extend[], and crossSection[] from that answer, along with these two additional functions for generating a suitable MeshRegion[] object: MakeTriangleMesh[vl_List, opts___] :=...


0

Example RegionQ @ Cylinder[] True RegionPlot3D @ Cylinder[] Output RegionQ @ Tube[{{0, 0, 0}, {1, 1, 1}}] False RegionPlot3D @ Tube[{{0, 0, 0}, {1, 1, 1}}] Output {Tube[{{0,0,0},{1,1,1}}]} is not a valid region to plot. EDIT In order to achieve region look-a-like Tube, see implementation below. Example region = Fold[...


8

I think this may be the behavior you desire. I am borrowing Kuba's modified ClipPanes specification. One should not need RawBoxes here I think but it does serve the purpose to get our Dynamic expression into the Front End box form. DynamicModule[{vp}, {vp} = Options[Graphics3D, ViewPoint][[All, 2]]; Graphics3D[{FaceForm[Red, Blue], Sphere[]}, Axes ...


3

Skip that and go upvote Mr.Wizard's answer :-) I don't know much about rendering of Graphics3D by FrontEnd, but I'd expect ClipPlanes to accept Dynamic setting. GraphicsBox3D stays the same after changing it so it seems it is a FrontEnd which handles it anyway. It is not the case but we can deal with that problem. we need Dynamic @ Graphics3d we need ...


6

{a, m, n, k} = {1, 4, 1, 8}; ParametricPlot3D[a Cos[m t] Cos[n s]^k Cos[s] { Cos[t], Sin[t], Sin[s]/Cos[s]}, {s, -Pi, Pi}, {t, -Pi, Pi}, PlotRange -> All, Mesh -> 40] Alternatively, x[s_, t_] := a Cos[m t] Cos[n s]^k Cos[t] Cos[s]; y[s_, t_] := a Cos[m t] Cos[n s]^k Sin[t] Cos[s]; z[s_, t_] := a Cos[m t] Cos[n s]^k Sin[s]; ParametricPlot3D[{...


1

In order to perform the Manipulate that you are looking for we really only need three functions (see Feyre's comment). My interpretation is that you could use: kbA[θ_] := 6.80414/((θ/10 - 0.119974) Sqrt[-1.19974 + θ]) kbM[θ_] := 37037/(20.468 + 22.4478 θ + 8.2063 θ^2 + θ^3) cfun[kA_, kM_] := kA^(1/3) + kM^(2/3) - 8 (kA + kM)/100 Now we can define your ...


3

data = {{0.000824, 15.8, 39.0}, {0.000507, 20.5, 39.6}, {0.000444, 20.5, 39.8}, {0.000380, 20.4, 40.8}, {0.000317, 22.0, 40.9}}; bcdata = {##, 1} & @@@ data; labels = Style["P" <> #, 16, Bold] & /@ CharacterRange["1", "5"]; BubbleChart3D[bcdata, Boxed -> False, Axes -> True, FaceGrids -> All, AxesLabel -> {"Oxygen ...


0

point = {{0.000824, 15.8, 39.0}, {0.000507, 20.5, 39.6}, {0.000444, 20.5, 39.8}, {0.000380, 20.4, 40.8}, {0.000317, 22.0, 40.9}}; Graphics3D[{{Red, MapIndexed[Text["P" <> ToString[First[#2]], #1 + {0, .2, 0}] &, point]}, PointSize[.01], Point[point]}, Boxed -> True, PlotRange -> CoordinateBounds[point, {2, .5, .5}], Axes -> ...


0

Description This solution does not fully cover the requirements of the original post, but it does achieve the desired output. In order to visualize how arbitrary gas cloud fills up the available volume, I have combined two Cuboid regions using RegionUnion. This new region has then been tested for intersection with a Ball of varying radii using ...


6

I hardly think that this is the best way and it may not even fit with your data because the view point will be fixed. However, if you remove the box and axes you can draw the two pictures and manually insert the x, y and z box lines. Then use Translate to shift the figure with the infinite plane an arbitrary distance (I used -1 for x, 3 for y and 0 for z). ...


1

In addition I added a point animation and observed some oddly behaviour of Dynamic and ContourPlot3D. Functions and Conditions. yPath has to be defined immidiately (without ":") cause the later \ recursive defintion wouldn' t work otherwise yPath[x_] = -((3 Sqrt[25 - x^2])/5); zPath[x_] := Sin[x] Sin[yPath[x]] comparison[x_] := yPath[x] == (-yPath[x]) ...


4

I am not entirely sure what the aim is here. I am choosing a different ellipse. However, this could be easily changed. p3 = Plot3D[Sin[x] Sin[y], {x, -5, 5}, {y, -5, 5}, PlotStyle -> {Green, Opacity[0.5]}, Mesh -> False]; cp = ContourPlot3D[ x^2/25 + y^2/9 == 1, {x, -5, 5}, {y, -5, 5}, {z, -1, 1}, Mesh -> None, ContourStyle -> Opacity[...


1

I'm on 10.0 for Mac OS X x86 (64-bit) (December 4, 2014) Plotting a Function see Function Visualization, ContourPlot3D[-5 (x - 2) - 7 y + 3 (z + 4) == 0, {x, -10, 10}, {y, -10, 10}, {z, -10, 10}] Adding a plan z an y, cp1 = ContourPlot3D[{-5 (x - 2) - 7 y + 3 (z + 4) == 0, z, y} , {x, -10, 10}, {y, -10, 10}, {z, -10, 10} , ContourStyle -> {Red, ...


1

Try the following: first solve with respect to z: sl = Solve[-5 (x - 2) - 7 y + 3 (z + 4) == 0, z] (* {{z -> 1/3 (-22 + 5 x + 7 y)}} *) Then plot it in 3D: Plot3D[sl[[1, 1, 2]], {x, -1, 1}, {y, -1, 1}] Have fun!


3

For changing the position of the cylinder you could add a dynamic Slider. Regard that "Show" won't work within "Dynamic", so thats why I wrote the trigonometric function in the contour argument. dx = 0; dz = 0; Row[{Slider2D[Dynamic[{dx, dz}], {{-10, -10}, {10, 10}}], "dx =" Dynamic[dx], ", dz =" Dynamic[dz]}] Dynamic[ContourPlot3D[{((x + dx)/5)^2 + ((z ...


2

You might look into ContourPlot3D: p1 = ContourPlot3D[(x/5)^2 + (y/3)^2 == 1, {x, -10, 10}, {y, -10, 10}, {z, -10, 10}, ContourStyle -> LightBlue]; p2 = Plot3D[Sin[x] Sin[y], {x, -10, 10}, {y, -10, 10}]; Show[p1, p2] Of course, if you want to do a little more with this, it helps to put both in a contourplot. So, how do we get the intersection of ...


4

In case size means length of each edge: edgeLength = PolyhedronData["TruncatedCube", "EdgeLengths"][[1]]; Graphics3D[ GeometricTransformation[ First @ PolyhedronData["TruncatedCube"], ScalingTransform[{1, 1, 1} (Sqrt[2] - 1)/edgeLength] ] , Axes -> True ]



Top 50 recent answers are included