Hot answers tagged

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


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


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


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


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


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


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


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


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


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


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


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___] :=...


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


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


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 ]


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


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


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


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


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


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


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]


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


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


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


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


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


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


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



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