Tag Info

Hot answers tagged

45

Yes we can. The following DashedGraphics3D[ ] function is designed to convert ordinary Graphics3D object to the "line-drawing" style raster image. Clear[DashedGraphics3D] DashedGraphics3D::optx = "Invalid options for Graphics3D are omitted: `1`."; Off[OptionValue::nodef]; Options[DashedGraphics3D] = {ViewAngle -> 0.4, ViewPoint ...


39

We can do this by building a regular hexagon tile and wrapping it onto a torus: hexTile[n_, m_] := With[{hex = Polygon[Table[{Cos[2 Pi k/6] + #, Sin[2 Pi k/6] + #2}, {k, 6}]] &}, Table[hex[3 i + 3 ((-1)^j + 1)/4, Sqrt[3]/2 j], {i, n}, {j, m}] /. {x_?NumericQ, y_?NumericQ} :> 2 π {x/(3 m), 2 y/(n Sqrt[3])} ] ht = ...


25

Yet another method: Let us calculate values of function on appropriate rectangular grids, which we will convert to textures (1 pixel = 1 value). Interpolation between pixels is built-in. f = 2 #1^2 + 2 #2^2 + #3^2 + #1 #2 &; PolyhedronData["Cube"] // N // Normal // toTriangles // texturize[f, 50, Hue, Lighting -> "Neutral", Axes -> True] ...


24

I doubt you can find a chart for all options, but take a look at this: For this and other insights two courses by Yu-Sung are a must (there are notebooks and videos there): Graphics Language Quick Start Visualization: Advanced 3D Graphics The above chart is from the 1st one. The one @Kuba links in the comment to your question is from the 2nd - I ...


22

One can also use MeshFunctions: Clear[f]; f = {x, y, z} \[Function] x + Sin[5 z] + y^2; cube = PolyhedronData["Cube", "RegionFunction"]; mesh = 15; RegionPlot3D[cube[x/2, y/2, z/2], {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, MeshFunctions -> {f}, Mesh -> mesh, MeshShading -> ColorData["Rainbow"] /@ Range[0, 1, 1/(mesh + 1)], PlotPoints -> 50, ...


21

I propose a small modification to the parametrization for the torus that addresses issues with conformality. Try F[t_, u_, r_] := {Cos[t] (r + Cos[u + Sin[u]/r]), Sin[t] (r + Cos[u + Sin[u]/r]), Sin[u + Sin[u]/r]} instead. Next, we wish to choose suitable values for $m, n$ for a given $r$ such that the mapping of the ...


17

Something to get you started? f[{x_, y_}] := -Cos[x] x^2 - y^2 xy = First[ ContourPlot[f[{x, y}], {x, -1, 1}, {y, -1, 1}]] /. {x_?AtomQ, y_?AtomQ} :> {x, y, 1}; xz = First[ ContourPlot[f[{x, y}], {x, -1, 1}, {y, -1, 1}]] /. {x_?AtomQ, y_?AtomQ} :> {x, -1, y}; yz = First[ ContourPlot[f[{x, y}], {x, -1, 1}, {y, -1, 1}]] /. ...


16

There is an explicit formula n = 30; m = 10; f[t_, u_] := {Cos[t] (3 + Cos[u]), Sin[t] (3 + Cos[u]), Sin[u]}; Graphics3D[Polygon /@ Table[ f[(4 π)/(3 n) (Cos[π k/3] + i 3/2), (2 π)/(Sqrt[3] m) (Sin[π k/3] + (j + i/2) Sqrt[3])], {i, n}, {j, m}, {k, 6}]] % /. Polygon -> Tube I find it a bit simpler than rm -rf's solution. Here f ...


15

Edit I had some time so I've added full surface torus. Old code in edit history. DynamicModule[{x = 2., l = 100., x2 = 2., l2 = 100., grid, fast, slow}, Grid[{{ Graphics3D[{ Dynamic[Map[{Blue, Polygon[#[[{1, 2, 4, 3}]]]} &, Join @@@ (Join @@ Partition[#, {2, 2}, 1]) ]&[ ...


15

Let's get a black torus: torus = First@ParametricPlot3D[{Cos[u] (3 + Cos[t]), Sin[u] (3 + Cos[t]), Sin[t]}, {u, 0, 2 Pi}, {t, 0, 2 Pi}, PlotStyle -> Black, Mesh -> None, PlotPoints -> 10] and now, this is a way to go: DynamicModule[{d1 = 0, d2 = 0}, Column[{ Graphics3D[{ ...


13

Interactive illustration of the most fundamental properties: Manipulate[ Column[{ Overlay[{ Framed[Graphics[{ LightYellow, Rectangle[{-plotRangePadding - plotRange, -plotRangePadding - plotRange}, {plotRangePadding + plotRange, plotRangePadding + plotRange}], LightGreen, ...


13

Nasser gives good standard ControlActive approach. But that by definition looses quality during motion. I just would like to share a trick that avoids that. Most of the time is spent on rendering your bell shape. But it is static. Plane moves but it is simple, so it should not all the time trigger recomputing of static bell shape. You can separate motion of ...


13

body[t_] = Integrate[#[u^2], {u, 0, t}] & /@ {Cos, Sin} ParametricPlot3D[body[t]~Join~{t}, {t, -2 Pi, 2 Pi}, BoxRatios -> 1, SphericalRegion -> True]


13

ClearAll[roundedCuboidF] roundedCuboidF[hprof_: 10, vprof_: 10, taper_: 1][box_] := ChartElementDataFunction["DoubleProfileCube", "HorizontalProfile" -> hprof, "VerticalProfile" -> vprof, "TaperRatio" -> taper][box] Graphics3D[roundedCuboidF[][{{0, 1}, {0, 1}, {0, 1}}], Boxed -> False] or ...


13

One of the main bottlenecks in your code are the texture you apply on each surface. Try to use texture = {}; in your drawTile function and the graphics should be faster by magnitudes. Additionally, as Yves mentioned, Tubes are a performance killer too. Therefore, a workaround for your problem might be to Rasterize the texture graphics by yourself and use ...


13

You can fix this problem by using the following Option in Graphics3D: Method -> {"CylinderPoints" -> {200, 1}} Adjust 200 to match your requirements. (Indeed the default is 40.) Edit: I don't know exactly what the second parameter does, but using the single parameter form shown in the documentation linked below results in a big slow-down. I ...


12

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]


12

You may try this eq = And @@ (Total[({x, y, z} - #)^2] > 1/2 & /@ Select[Tuples[{-1, 0, 1}, 3], Mod[Total[#], 2] == 0 &]) RegionPlot3D[eq, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, Mesh -> None, PlotPoints -> 150] Notice there are small holes at points of contact between the spheres. You can also "bound" by a sphere instead of a ...


12

You can add a tube around each of your tubes with a slightly bigger radius, transparent outer color, and white inner color. t1 = Tube[{{-0.2, -1, 0}, {-0.2, 1, 0}}, 0.05]; t2 = Tube[{{0, 0, -1}, {0, 0, 1}}, 0.05]; Graphics3D[{t1, t2, FaceForm[None, Glow[White]], MapAt[1.8 # &, #, 2] & /@ {t1, t2}}, Boxed -> False]


12

You can take advantage of the VertexNormals that Plot computes to translate the surface a little to each side. I'm not sure just what is required for good STL output. I put a polygonal side all around the two surfaces. The VertexNormals are wrong for the sides, so I commented them out for the image presented. The thickness is controlled by the parameter ...


12

Another way using textures: v = {{-1, -1, -1}, {1, -1, -1}, {1, 1, -1}, {-1, 1, -1}, {-1, -1, 1}, {1, -1, 1}, {1, 1, 1}, {-1, 1, 1}}; idx = {{1, 2, 3, 4}, {1, 2, 6, 5}, {2, 3, 7, 6}, {3, 4, 8, 7}, {4, 1, 5, 8}, {5, 6, 7, 8}}; vtc = {{0, 0}, {1, 0}, {1, 1}, {0, 1}}; f[{x_, y_, z_}] := x^2 - y^2 - z^2 q[j_] := MapThread[ Prepend, {{Min@#, Max@#} & ...


12

MeshFunctions are generally quite useful for making such demarcations: With[{d = {Thick, Yellow}}, Plot3D[1/(1 + E^(-a - c)), {a, -8, 8}, {c, -8, 8}, PlotPoints -> 50, MeshStyle -> {Black, Black, d, d, d}, Mesh -> {10, 10, {0}, {0}, {0}}, MeshFunctions -> {# &, #2 &, # &, If[# <= 0, # + #2] &, If[# <= ...


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

Thanks to ybeltukov I realised that post-processing way is not so bulletproof. Let's write a little bit longer solution to take control. ChartElementFunction, is a handy way to deal with this (only a little bit adapted example for documentation): f[{{xmin_, xmax_}, {ymin_, ymax_}, {zmin_, zmax_}}, ___] := { RGBColor[Mean[{xmin, xmax}], ...


11

A convenient resource for the Miller Indices can be found here. This ref provides sufficient information for us to draw the (111) and (110) planes. First, reproduce the graphic from the demonstration. I just made the necessary changes to make it run outside of a Manipulate and did not try to optimize it. tet = PolyhedronData["Tetrahedron", "Faces"]; tetv ...


11

Seeing Silvia's phenomenal answer I've been inspired to take a crack at this. My method requires the use of ColorFunction so it only works for plots rather than general Graphics3D geometry. However, it does find silhouette edges in the interior of the image, as well as those hidden behind other surfaces (such as the missing side walls of the internal ...


10

You need to use Normal to explicitly apply the various transformations, resulting in an ordinary collection of polygons which Export can translate to STL. Unfortunately, it looks like Normal has a problem when multiple transformations are supplied to GeometricTransformation. We need to handle this with a specific rule. Assuming g is your Graphics3D: gn = ...


10

There is a brute-force method: f = 2 #1^2 + 2 #2^2 + #3^2 + #1 #2 &; surface = PolyhedronData["Cube", "RegionFunction"][x, y, z]; r = 0.6; RegionPlot3D[surface, {x, -r, r}, {y, -r, r}, {z, -r, r}, PlotPoints -> 35, NormalsFunction -> None, Mesh -> None, ColorFunction -> (Hue@f[##] &), ColorFunctionScaling -> False] surface ...


10

Here is a bit clumsy (had very little time) approach виа combination of new functionality Entity and regions. (* get the states *) divisions = EntityValue[Entity["AdministrativeDivision", {_, "UnitedStates"}], "Entities"]; (* get polygons of borders *) dat = EntityValue[ divisions, {"Population", "Polygon"}] /. {GeoPosition -> Identity, ...


9

lpdata = Table[(4 Pi - t) {Cos[t + Pi/2], Sin[t + Pi/2], 0} + {0, 0, t}, {t, 0, 4 Pi, .1}]; lpp1 = ListPointPlot3D[lpdata, Filling -> Bottom, ColorFunction -> "Rainbow", BoxRatios -> 1, FillingStyle -> Directive[LightGreen, Thick, Opacity[.5]], ImageSize -> 400]; ListPointPlot3D: Post-process Point into Cone lpp2 = lpp1 ...



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