Tag Info

New answers tagged

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


4

You can use the option PlotStyle to style each of the three parts separately: PlotStyle -> {Opacity[.6], EdgeForm[{Opacity[1], Thick, Blue}], EdgeForm[{Opacity[1], Thick, Red}]} Since the three-argument form of ParametricPlot3D produces polygons (i.e., those lines are not Lines!), you need to set the styles using EdgeForm. We get a much cleaner ...


5

Using BoundaryStyle Use the option BoundaryStyle and set the option value to {{1, 2} -> Directive[Thick, Red]}: Plot3D[{-5 - x - y, -Sqrt[8 x^2 + 8 y^2]}, {x, -5, 5}, {y, -5, 5}, Mesh -> None, BoxRatios -> {1, 1, 1}, BoundaryStyle -> {{1, 2} -> Directive[Thick, Red]} ] Using MeshFunctions Use the difference between the two functions ...


3

Find equations for intersection: Solve[-5 - x - y == -Sqrt[8 x^2 + 8 y^2], x] {{x -> 1/7 (5 + y - 2 Sqrt[2] Sqrt[25 + 10 y - 6 y^2])}, {x -> 1/7 (5 + y + 2 Sqrt[2] Sqrt[25 + 10 y - 6 y^2])}} Range of y: Solve[25 + 10 y - 6 y^2 == 0, y] {{y -> 5/6 (1 - Sqrt[7])}, {y -> 5/6 (1 + Sqrt[7])}} Draw intersection: inter = With[ { x1 = ...


1

My understanding of the question is that you are not interested in doing a rotation of the 3D object inside the 3D scene, but instead want to do a 2D rotation of the displayed Graphics3D, as if the latter were just another 2D Graphics element.Then you want to combine the result with additional 2D Graphics using Show. For this task, the right tool is simply ...


2

myBox = Cuboid[{-40, 40, 0}, {40, 60, 10}]; Show@MapAt[Rotate[#, Pi/4, {0, 0, 1}, {0, 0, 0}] &, Graphics3D[myBox], {1}] Manipulate[Table[Show[Graphics3D[{Red, Sphere[{0, 0, 0}, 30], Green, Cylinder[{{30, 30, 30}, {40, 50, 40}}, 30]}], MapAt[Rotate[#, k, v, {0, 0, 0}] &, Graphics3D[myBox], {1}], Boxed -> False, PlotRange -> ...


14

Update: With the function top defined in the original post you can replicate all the cool things you see in rm-rf's answer in the linked Q/A. For example, with a slight modification of gr1, i.e., Graphics3D[hexTile[20, 20] /. Polygon[l_] :> {Directive[Orange, Opacity[0.8], Specularity[White, 30]], Polygon[l], Polygon[{Pi/5, 0} + {-1, 1} # & ...


1

circ := {Cos[#], Sin[#]} & quad = Interpolation[ Table[{f, {Cos[f], Sin[f]}}, {f, 0, 2 π, π/2}], InterpolationOrder -> 1] ParametricPlot3D[{quad[t] z + circ[t] (1 - z), z} // Flatten, {t, 0, 2 π}, {z, 0, 1}, Mesh -> None, PlotStyle -> Opacity[0.8], ColorFunction -> "Rainbow"]


3

A simple solution would be to wrap those expressions into a DynamicModule: DynamicModule[{vp, vv} , {vp, vv} = Options[Graphics3D, {ViewPoint, ViewVertical}][[All, 2]] ; { Graphics3D[Cuboid[], ViewPoint->Dynamic[vp], ViewVertical->Dynamic[vv]] , Graphics3D[Cuboid[], ViewPoint->Dynamic[vp], ViewVertical->Dynamic[vv]] } // GraphicsRow ] ...


1

You can specify the setting for the option Mesh to include graphics directives: ContourPlot3D[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, {a, 0.9, 5.1}, MeshFunctions -> {#3 &}, Mesh -> {Table[{a, Hue[(a - 1)/4]}, {a, 1, 5, 0.5}]}, ContourStyle -> None, BoundaryStyle -> None, BaseStyle -> Thick]


6

A quick one based on your phase diagram context, where bg contains the color of your 2D planes: g = Table[ParametricPlot3D[{y^2/a, y, a}, {y, -2, 2}, PlotStyle -> Hue[(a*2 - 1)/10]], {a, 1, 5, 1}]; bg = Table[ContourPlot3D[z == a, {x, -4, 6}, {y, -4, 4}, {z, .8, 5.2}, Mesh -> None, ContourStyle -> Directive[Hue[1 - (a*2 - 1)/10], Opacity[0.3]]], ...


9

A method of assembling 2d contour plots ... Show[Table[ Graphics3D@ First@Cases[ Normal@ContourPlot[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, Frame -> False], Line[x_] :> {Hue[(a - 1)/4], Line[Append[#, a] & /@ x]}, Infinity], {a, 1, 5, .5}] ,PlotRange->All] ...


6

Here's one way: ContourPlot3D[y^2 == a*x, {x, 0, 2}, {y, -2, 2}, {a, 0.9, 5.1}, MeshFunctions -> {#3 &}, Mesh -> {Table[a, {a, 1, 5, 0.5}]}, ContourStyle -> None, BoundaryStyle -> None] /. GraphicsComplex[p_, g_, opts___] :> GraphicsComplex[p, g /. Line[v_] :> {Hue[((p ~Part~ v[[1]] ~Part~ 3) - 1)/4], Thick, ...


4

With caffeine as the example molecule molecule = Import["ExampleData/caffeine.xyz"] one can find all spheres that represent the single atoms using sphereList = Cases[molecule[[1, 4, 2]], _Sphere] {Sphere[1,24.],Sphere[12,24.],Sphere[14,24.],Sphere[15,24.],Sphere[16,24.],Sphere[17,24.], ...


1

You can use the unscaled function and just scale the ticks (see Ticks for details): ticks1 = Table[{n, n*10^6}, {n, -10^-4, 10^-4, 1/2 10^-4}]; Plot3D[F[r, y], {r, -10^-4, 10^-4}, {y, -1.5 10^-4, 10^-4}, PlotRange -> All, AxesLabel -> {Text[Style["r (m)", Italic, 14]], Text[Style["y (m)", Italic, 14]], Text[Style["F (TN)", Italic, 14]]}, Ticks ...


10

In spirit of djp's answer: one can put a point lighting source at the camera position to distinguish distances to spheres. With the option Lighting -> {{"Point", White, ImageScaled@{0, 0, 0}, {0, 0, 5}}} I obtain


5

Show the spheres together with a black semi-opaque bitmap. It gives "fog", but not blur. spheres = Table[Sphere[ RandomVariate[UniformDistribution[{0.2, 0.8}], 3], .01], {100}]; cube = {{{RGBColor[0, 0, 0, 0.07]}}}; c = Image3D[cube]; s = Graphics3D[spheres, Background -> Black, ImageSize -> Large]; Show[s, c] It gives distance, but not ...



Top 50 recent answers are included