Tag Info

Hot answers tagged

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


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 ]


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


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


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


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


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


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


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]


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


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


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


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}] &[ ...


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


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


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


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


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


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


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


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


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]


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


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


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


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


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.


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.



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