Tag Info

New answers tagged

0

If you use Mathematica 10: plotrange = {{0, 1}, {0, 1}, {-1, 1}}; edges = Composition[ Part[#, {8, 7, 4, 6, 2, 10, 9, 5, 1, 3, 11, 12}] &, Delete[#, List /@ {1, 5, 6, 9, 11, 15}] &, MeshPrimitives[#, 1] &, BoundaryDiscretizeRegion, Apply[Cuboid], Transpose ][plotrange]; Show[ Plot3D[ Sin[Pi*x]*Sin[2 Pi*y], {x, 0, 1}, ...


3

testGraph = ListPlot3D[data, Mesh -> None, InterpolationOrder -> 3, ColorFunction -> "SouthwestColors", AxesLabel -> {Rotate["Number of Processes", - 20 Degree], Rotate["Number of Operations", 60 Degree], Rotate["Time (ms)", 95 Degree]}, ImageSize -> 450]


13

The blue line occurs at the edge of the function, where ϕ wraps from 2π to 0. We can get rid of it by adding BoundaryStyle -> None: SphericalPlot3D[ Abs[.5 + Sin[2 ϕ]/2] Sin[θ] + Abs[.5 + Sin[2 (ϕ + π/2)]/2] Sin[θ], {θ, 0, π}, {ϕ, 0, 2 π}, PlotStyle -> {Opacity[0.3], Yellow}, BoxRatios -> {1, 1, 1/2}, MeshFunctions -> {#3 &}, ...


1

Well, if you don't want to use FaceGrids (which can be pretty ugly), you could construct the box you want by hand: With[{xi = 0, xf = 1, yi = 0, yf = 1, zmin = -1, zmax = 1}, Show[Plot3D[Sin[Pi*x]*Sin[2 Pi*y], {x, xi, xf}, {y, yi, yf}, Boxed -> False], Graphics3D[{ GrayLevel[0.75], Line[1.02{ {xi, yi, zmin}, {xi, yf, zmin}, ...


2

Update: ... the middle part is not wider/longer than the others, it just has more points... SeedRandom[1] {part1, part3} = RandomInteger[10, {2, 10, 10}]; part2 = RandomInteger[10, {20, 30}]; i = 1; {lp1, lp2, lp3} = ListPlot3D[#, DataRange -> {{0, 1}, {0, 1}, {0, 10}}, InterpolationOrder -> 3, PlotStyle -> {Blue, Red, Green}[[i++]], ...


4

Update: Recycling the function tickF from this answer to construct a function, axesF, to create axes and ticks primitives, to get ClearAll[tickF, axesF, boxF]; tickF[div1_, div2_: - 1] := (If[div2 == -1,Thread[{#, #, {.02, 0}}, List, 2] &@ FindDivisions[{#1, #2}, div1], Join @@ MapAt[Join @@ # &, {Thread[{#, #, {.02, 0}}, List, 2] ...


1

I think something like this is what you're after: ListPlot3D[Transpose[{x, y, z}], ColorFunction -> Function[{x, y, z}, Hue[x]]] Put whatever tickles your fancy into the function for the mapping of n to colors, and check the documentation for ColorFunction (and associated things like ColorFunctionScaling) to fine-tune.


4

There's no clean way to do this without re-creating the box and axes yourself. So here is how far I managed to get by just abusing Inset: Show[RegionPlot3D[ x^2 + y^3 - z^2 > 0, {x, -2, 2}, {y, -2, 2}, {z, -2, 2}, Boxed -> True, Axes -> True, BoxRatios -> Automatic], Graphics3D[ Inset[ Graphics[ Inset[ Graphics3D[Sphere[{0, 0, ...


2

Euler characteristic Vertices - Edges + Faces for torus equals 0. So you can see that when you have n regular haxagons: 6n/3 - 6n/2 + n == 0 (*each vertex is shared between 3 polygons*) (*each edge is shared between 2 polygons*) is fulfilled for any n. That is why it was relatively easy to do what is done in linked answer. As Szabolcs has pointed ...


3

rad[v_, h_] := v + h; (* for example *) Here are a few ways to add multiple labels in/around a graphics object: Manipulate[Labeled[Graphics3D[Cylinder[{{0, 0, 0}, {0, 0, h}}, rad[v, h]], PlotLabel -> Column[Style[#, 20] & /@ {Row[{oo[h], ooo[v]}, ","], ooo[v + h], "... so on"}, Alignment -> Center], Axes -> Automatic], ...


3

Specifying an explicit PlotRange and moving the Dynamic outside the list in Graphics3D seems to create a smoother experience: DynamicModule[{vv = {0, 0, 1}, vp = {1.3`, -2.4`, 2.`}}, Graphics3D[ Dynamic[{Cuboid[], Line[{{0, 0, 0}, vv}]}], ViewPoint -> Dynamic[vp], ViewVertical -> Dynamic[vv], Boxed -> False, SphericalRegion ...


1

Export["mobius.stl", mobius] creates the desired file, which I can open with Photoshop CC, producing B&W top and side views. Presumably, more specialized software would give a true 3D image, although still B&W.


3

Input your line through the origin as myVec: myVec = {-2, 3, 1}; Graphics3D[{ Rotate[Cuboid[{-.5, -.5, -.5}], Dynamic[MousePosition[][[1]]/10], {-2, 3, 1}], Line[{myVec, -myVec}]}] or... myVec = {-2, 3, 1}; Graphics3D[{ Rotate[PolyhedronData["Icosahedron", "Faces"], Dynamic[MousePosition[][[1]]/10], myVec], Line[{myVec, -myVec}]}]


2

Using a set-up similar to Taiki, but taking literally the OP's request for 2D slices instead of the thin 3D slices in the OP's code: SeedRandom[1]; xrange = {-5, 5}; yrange = {-5, 5}; zrange = {-5, 5}; cylinders = Table[Cylinder[ Table[RandomReal /@ {xrange, yrange, zrange}, {2}]], {10}]; plots = Block[{reg}, reg = Compile @@ {{x, y, z}, ...


3

Let me present a geometric approach. xrange = {-5, 5}; yrange = {-4, 4}; zrange = {-3, 3}; rrange = {1/2, 1}; xrangeext = {-#, #} &@ Max[rrange] + xrange; yrangeext = {-#, #} &@ Max[rrange] + yrange; zrangeext = {-#, #} &@ Max[rrange] + zrange; cylinders = Table[ Cylinder[Table[RandomReal /@ {xrange, yrange, zrange}, {2}], RandomReal[rrange]], ...


1

ℛ = ImplicitRegion[x^2 + y^2 <= 1 && Abs[z] < 5, {x, y, z}]; RegionPlot3D[ℛ, PlotPoints -> 100, PlotRange -> {{-2, 2}, {-2, 2}, {-6, 6}}] // Quiet slice =RegionIntersection[ℛ, ImplicitRegion[x^2 + y^2 < 2 && Abs[z - .5] < .01, {x, y, z}]]; RegionPlot3D[slice, PlotPoints -> 100, PlotRange -> {{-2, 2}, ...


1

I know it's been more than two years since the question was asked but please allow me to answer nevertheless for future reference. According to Wikipedia articles on Mollweide and equirectangular projections, the function mollweidetoequirect that converts the former to the latter can be constructed as follows: lat[y_, rad_:1] := ArcSin[(2 theta[y, rad] + ...


5

Circle Let's create circle3D that is something you would expect from Circle but with an extra argument for its normal vector. With circle3D[centre_: {0, 0, 0}, radius_: 1, normal_: {0, 0, 1}, angle_: {0, 2 Pi}] := GeometricTransformation[#, RotationTransform[{{0, 0, 1}, normal}, centre]] &[ Map[Append[#, Last@centre] &, #, {3}] &[ ...


2

I've found this useful on a number of occasions: use a BezierCurve, which can be a 3D object, to approximate a circle. bezierarc[xc_, a_, b_ , r_: 1, n_: {0, 0, 1}] := (* Bezier approximation to an arc *) (*Excellent approximation for included angle b-a < Pi/2 *) (* "pretty good" approximation for b-a< Pi *) Module[{rstar, del, p, c, ...


4

A simple approach: i = Import["http://i.stack.imgur.com/Jzimv.png"]; i = ImageResize[i, 200]; Image3D[Table[i, {200}]] If it's just for display, there is no need to create multiple copies of the image - just make a 3D image one pixel deep and use BoxRatios to stretch it vertically: Image3D[{i}, BoxRatios -> {1, 1, 1}]


4

You can also use Exclusions with ParametricPlot3D: ParametricPlot3D[{Cos[u] Sin[v], Cos[u] Cos[v], Sin[u]}, {u, -π, π}, {v, -π/2, π/2}, Mesh -> None, PlotStyle -> Opacity[.25, Blue], PlotPoints -> 80, MaxRecursion -> 4, Exclusions -> {Cos[u] Cos[v] == .7}, ExclusionsStyle -> ({Directive[Opacity[1], Thick, Red]})]


5

You can also plot two partial spheres and highlight where they meet smallSphere = ParametricPlot3D[ {Cos[θ] Sin[ϕ], Cos[θ] Cos[ϕ], Sin[θ]}, {θ, -π, π}, {ϕ, -π/2, π/2}, Mesh -> None, PlotStyle -> {LightBlue, Opacity[0.4]}, BoundaryStyle -> Directive[Thick, Red], RegionFunction -> (#2 > .6 &) ]; bigSphere = ...


13

Usage Just use this function with any polyhedron in in form: GraphicsComplex[pts_, Polygon[vertices_, ___]]. When I find time and motivation maybe I will add more DownValues so it can be more general. Atm you can play with solids given by PolyhedronData[... "Faces"]: polyhedronRandomWalk[ PolyhedronData["DuerersSolid", "Faces"] ] It ...


1

Whereas the problem above is not solved I finally found a proper formulation of the Klein bottle immersion in 3 dimensions: r = 4 (1 - cos(u)/2) x = Piecewise[({ {r cos(u) cos(v) + 6 (sin(u) + 1) cos(u), 0 <= u < \[Pi]}, {r cos(v + \[Pi]) + 6 (sin(u) + 1) cos(u), \[Pi] <= u <= 2 \[Pi]} })] y = Piecewise[({ {r sin(u) cos(v) + 16 ...


5

draw[sphere : {sC_, sR_}, circle: {ctr_, pt_}] := ParametricPlot3D[sR {Cos[u] Sin[v],Sin[u] Sin[v],Cos[v]}+sC, {u,0,2 Pi}, {v,0,2 Pi}, MeshFunctions -> (Norm[{##}[[1;;3]]-ctr] - Norm[ctr-pt] &), Mesh -> {{0}}] SeedRandom[42]; sCenter = {1, 1, 1}; sRadius = 1; cs = Map[Plus[Normalize[#], sCenter] &, RandomReal[{-1, 1} sRadius, {10, 2, 3}], ...


14

center = Normalize@{1, 2, 3}; point = Normalize@{0, 2, 1}; with minimum of algebra: Show[ ParametricPlot3D[ Evaluate[ N[center + RotationMatrix[t, center].(point - center)]], {t, 0, 2 Pi}], Graphics3D[{Sphere[], Blue, Sphere[{center, point}, .05]}] , PlotRange -> 1.1 ]


7

circle is 2D and sphere is 3D. Hence you are missing one dimension to make them both show together. i.e. you need orientation for the circle. This should get you started. You can approximate a circle with Cylinder of very small length. Graphics3D[{ {Red, Cylinder[{{1, 0, 0}, {1.01, 0, 0}}, 1]}, Sphere[{0, 0, 0}, 1] }, Boxed -> False]


1

Show[ConvexHullMesh[data], BoxRatios -> {1, 1, 1}, Axes -> True, ImageSize -> 500]


0

Show[DelaunayMesh[ Union[datafront, databack, datatop, databottom, dataleft, dataright]], BoxRatios -> {1, 1, 1}, Axes -> True, ImageSize -> 500]


1

Let me update Simon's code for Mathematica 10. We no longer need to explicitly load TetGenLink. tetrahedra = Level[MeshPrimitives[DelaunayMesh[data3D], 3], {-3}]; radius[p_] := Sqrt[Area[Circumsphere[p]]/(4 Pi)]; radii = radius /@ tetrahedra; alphashape[rmax_] := Pick[tetrahedra, radii, r_ /; r < rmax] faces[tetras_] := Flatten[ tetras /. {a_, b_, c_, ...


8

I just finished blog post about the creation of nice graphics from Mathematica Graphics3D using the Blender render framework: http://wolfig-techblog.blogspot.de/2015/04/blender-as-shader-for-mathematica.html Maybe you can find some inspiration there for your own graphics. I managed to generate a reasonable Klein bottle with glass shading: Note: the ...


3

Motivation The following gives some idea of what the data looks like: Graphics3D[ Polygon /@ (Module[ {center, pts}, pts = #; center = Mean[pts]; SortBy[pts, (N[ArcTan @@ Most[# - center]] &)] ] &) /@ GatherBy[data, #[[3]] &], Axes -> True, Boxed -> True, BoxRatios -> {1, 1, 1}, ViewPoint -> 1000 {1, 1, ...


0

I'm also on a Mac with v10 and see no issues. Perhaps you could try using Export and experimenting with the ImageSize and ImageResolution settings. Export["~/Desktop/imgTEMP-800-300.pdf", plot1, ImageSize -> 800, ImageResolution -> 300]


6

An FEM element-meshing approach. The quality is controlled by the option "MaxCellMeasure" -> {"Length" -> 0.05}. Note that the VertexNormals -> -coords option causes the polygonal sphere to be smoothed out when displayed on the screen. Needs["NDSolve`FEM`"]; points = {{-0.9207, -0.3896, 0.0091}, {-0.8272, 0.5077, -0.2399}, {0.2544, -0.3511, ...


11

Let me add another answer. This code is much shorter and faster than my previous one, and the resulting mesh of each face is much cleaner. The procedure is simple. Triangles are first made from the given face vertices and discretised. Each mesh point is then pushed onto a 2-sphere while its angular positions are maintained. points = { {-0.9207, -0.3896, ...


4

Using the option Exclusions->None fixes the issue in both plots: ContourPlot[L, {x, 0, xmax}, {y, 0, ymax + 1}, Contours -> 50, ColorFunction -> Function[{x, y, z}, Hue[x]], Exclusions -> None] Plot3D[L, {x, 0, xmax}, {y, 0, ymax + 1}, ColorFunction -> Function[{x, y, z}, Hue[z]], Mesh -> None, ClippingStyle -> {Blue, Red}, ...


11

What about some 2D Geo functionality for this? points = {{-0.9207, -0.3896, 0.0091}, {-0.8272, 0.5077, -0.2399}, {0.2544, -0.3511, 0.9010}, {0.3510, 0.6527, 0.6712}, {0.5436, -0.6326, -0.5513}, {0.6016, 0.2317, -0.7643}}; edges = {{1, 2}, {1, 3}, {1, 5}, {2, 4}, {2, 6}, {3, 4}, {3, 5}, {4, 6}, {5, 6}}; Construct the geodesics as GeoPath objects: latlons ...


13

Using the same initialization code as Taiki: origin = {0, 0, 0}; points = {{-0.9207, -0.3896, 0.0091}, {-0.8272, 0.5077, -0.2399}, {0.2544, -0.3511, 0.901}, {0.351, 0.6527, 0.6712}, {0.5436, -0.6326, -0.5513}, {0.6016, 0.2317, -0.7643}}; fs = {{1, 3, 5}, {1, 2, 4, 3}, {1, 2, 6, 5}, {3, 4, 6, 5}, {2, 4, 6}}; faces = points[[#]] & /@ fs; Then ...


15

A crude attempt This is for Mathematica 10+ only. To construct each face, I use an intersection between a unit 3-ball centred at the origin and a pyramid whose base is at infinity and apex is at the origin. Each edge of the pyramid passes through each vertex of the spherical face. The pyramid is given by ConicHullRegion[{origin}, {vertices}]. The ...


0

Graphics3D[ Table[ {Cylinder[{{x, y, 0}, {x, y, 1}}], Text[Style[ToString[x/2] <> "," <> ToString[y/2], 24, Gray], {x, y, 1}]}, {x, 0, 5, 2}, {y, 0, 5, 2}] ] Or why not just use a different color on each, and then have a legend?


6

Just add a fixed PlotRange like this : pics = Table[ Graphics3D[{{Opacity[0.1], EdgeForm[None], Cone[{{0, 0, 0}, {0, 0, -2}}, 1]}, {Yellow, Sphere[{0, 0, -2}, 0.1]}, {Dashed, Arrow[{{0, 0, -2}, {0, 0, 0}}]}, GeometricTransformation[{Red, Arrowheads[0.03], Arrow[Tube[{{0, 0, -2}, {0, 1, 0}}, 0.005]]}(*{Black,Arrow[{{0, ...



Top 50 recent answers are included