Tag Info

New answers tagged

2

while Cuboid[] is a region by definition and will work in the above code, Translate[Rotate[Cuboid[]]] is not a region TransformedRegion may be useful, for example fiberlist = Table[ TransformedRegion[ Cuboid[{0, 0, 0}, {2, 2, 10}] , Composition[ RotationTransform[RandomReal[{0, Pi}], {RandomReal[], RandomReal[], RandomReal[]}] ...


1

The problem lies with using Sphere (or Circumsphere), which are actually surfaces rather than solids. Instead use Ball: a = 1; p0 = {0, 0, 0}; p1 = a {0, 0, Sqrt[2/3] - 1/(2 Sqrt[6])}; p2 = a {-(1/(2 Sqrt[3])), -(1/2), -(1/(2 Sqrt[6]))}; p3 = a {-(1/(2 Sqrt[3])), 1/2, -(1/(2 Sqrt[6]))}; p4 = a {1/Sqrt[3], 0, -(1/(2 Sqrt[6]))}; cs = Circumsphere[{p1, p2, p3, ...


3

You can't make worms with a cylinder ... but a Tube: Graphics3D[ Tube[BSplineCurve[{{1, 1, -1}, {2, 2, 1}, {3, 3, -1}, {3, 4, 1}}], .5]] Tube takes a Line or curve to build itself around, or two endpoints. It also generates caps in a different way.


6

There are lots of places where you can indeed replace Cylinder by Tube, but Tube allows more styling options and flexibility. Most of this information can be collected from the documentation, so I'll just list some aspects that I think are especially noteworthy: In terms of regions, it seems to me that you already answered the question: you can't use Tube ...


0

Manipulate[ Graphics3D[Tetrahedron[], ViewPoint -> 5 {Cos[\[Theta]] Sin[\[Phi]], Sin[\[Theta]] Sin[\[Phi]], Cos[\[Phi]]}], {\[Theta], 0, 2 \[Pi]}, {\[Phi], 0, \[Pi]}]


0

You can strip the frame and padding from the contour plot and the OP's approach seems to work. cp5 = ContourPlot[Sin[x]^2 + 2 y, {x, 0, 2 π}, {y, 0, 4}]; values = {{0, 0, 0.2`}, {0, 1, 0.3`}, {0, 3.5`, 0.43`}, {0, 4, 0.2`}, {(2 π)/3, 0, 0.38`}, {(2 π)/3, 1, 0.45`}, {(2 π)/3, 3.5`, 0.25`}, {(2 π)/3, 4, 0.1`}, {(4 π)/3, 0, 0.37`}, {(4 π)/3, 1, 0.4`}, ...


2

I contacted Wolfram Support and they recommended that I reinstall Mathematica, following these directions: http://support.wolfram.com/kb/12473 It seems to have worked. Rotated images are no longer turning black. We'll see how it goes in the future. D.


2

Here is a quick and somewhat dirty solution. Legended[ Show[PIC1, PIC2, PIC3], SwatchLegend[ {Yellow, Blue, Green}, {"Cos[x] Cos[y]", "-(x-Pi/2) (y+Pi/2)", "(x-Pi/2) (y+Pi/2)"}]]


1

data = {150, 148, 145, 144, 143, 80, -80, -81, -82, -83}; omega = Interpolation[data, InterpolationOrder -> 4]; omegaIntegrate := Integrate[omega[s], s]; Animate[Graphics3D[{Cuboid[{-20, -20, -1.01}, {20, 20, -1}], GeometricTransformation[{Green, Tube[{{0, 0, 0}, {0, 0, 0.15}}, {1.25, 0}], Cylinder[{{0, 0, 0}, {0, 0, 1}}, 1/4], Blue, ...


1

Graphics3D[ Table[ Translate[ Rotate[First@ChemicalData["Water", "MoleculePlot"], RandomReal[{0, \[Pi]}], {8, .5, 0}], {80 i, 160 RandomReal[{-1, 1}], 160 RandomReal[{-1, 1}]}], {i, 1, 20}] ]


11

One very clean way to do this is via x3dom, which is a javascript framework for deploying the x3d standard. The library is well supported by modern browsers, and the output is an html file with a supporting archive of x3d files. It is generally very clean and fast, and it does not require any external plugins. The library can be called from the x3dom site or ...


2

This is not a full answer, but it, perhaps, deals with the hardest part: constructing a set of finite lines lying all in one plane, but not intersecting each other. appendLine[list_Symbol] := (list = RandomReal[10, {1, 2, 2}]) appendLine[list_List] := Module[{newline, test = True}, For[newline = RandomReal[10, {2, 2}], test, test = ! ...


2

As in my comment, I feel, it's cleaner to use Show[(Pick[HoldComplete[{regionPlot, contourPlot}], {{True, showQPlane}}])[[1]]] Additionaly I use SetDelayed in the definition of contourPlot to prevent evaluation at definition and HoldComplete makes sure that first Pick is run, and only then what's left is evaluated. [[1]] strips the result of Pick of the ...


1

This is a minimal example of how to do something like this: Manipulate[ plot1 = Graphics3D@Sphere[{0, 0, 0}, 1.3]; If[x, Print@"Calculating plot2"; plot2 = Graphics3D@Cylinder[]]; Show[{plot1, If[x, plot2, {}]}] , {{x, True}, {True, False}} ] Body of the Manipulate is inside Dynamic so if you want to be able to control what is sent to ...


2

As @Mr.Wizard pointed out, multiple interesting solutions to your problem have been proposed on this site. I just wanted to add an observation here. I realize that you did not say so explicitly, but I would think that many users would try some combination of ListPointPlot3D for this kind of task. However, it has been my impression when using the *3D list ...


1

Use Animate and define your curve.. Animate[Graphics3D[Sphere[{Sin[t], Cos[3 t], 0}, .1], PlotRange -> {{-2, 2}, {-2, 2}, {-2, 2}}], {t, 0, 2 Pi}]


3

For the record, this can be solved by setting Exclusions -> None in Plot3D, which tells Mathematica not to exclude subregions of the domain that are associated with discontinuities. Generally, if you want that plot to look sharp, you will have to couple it with a largish number for MaxRecursions: Plot3D[E^-(x - Round[x])^2, {x, 0, 3}, {y, 0, 3}, ...


2

Maybe this will get you started. What's left is to use a 3D "locator" from the OP's linked question to connect a mouse click to setting the target of ViewVector. g = Graphics3D[ Table[{EdgeForm[Opacity[.3]], Opacity[.5], Hue[RandomReal[]], Cylinder[RandomReal[10, {2, 3}]]}, {5}]]; Manipulate[ Show[g, Graphics3D[{Sphere[target, 0.3]}], ...


4

Here's an approach using ParametricPlot3D, in which spheres are plotted and then sliced off using the option RegionFunction. It's not clear to me how you intend to have the inner regions "blank" as they are occluded, but the options to Show let you vary the appearance. outerSphere[sphereCenter_: {0, 0, 0}, regionLimit_: 0.6, color_, opacity_] := Module[ ...


7

Here is an alternative to RegionPlot that potentially produces higher quality: it's based on Tube with varying radius, as I also used in this answer: With[ {a = 1, R = .7, n = 40, xMax = 1.5}, Manipulate[ Graphics3D[ GeometricTransformation[ {CapForm[None], {Opacity[.5], Pink, #, Cyan, GeometricTransformation[#, {{-1, 0, 0}, ...


1

As a cone (with a square base), the volume is one-third the base times the height: 1/3 * (4 Sqrt[2])^2 * 8. Another plot, based on the OP's coordinates: ConvexHullMesh@Join[4 IdentityMatrix[3], -4 IdentityMatrix[3]]


1

An alternate approach to calculating the volume Integrate[ Boole[Abs[x] + Abs[y] + Abs[z] < 4], {x, -Infinity, Infinity}, {y, -Infinity, Infinity}, {z, -Infinity, Infinity}] 256/3


2

A small addition from Mathematica v. 10 In his answer @Ivan has already nailed the most important part of the question, i.e. the formal representation of your region as an ImplicitRegion object: region = ImplicitRegion[Abs[x] + Abs[y] + Abs[z] < 4, {x, y, z}] I just wanted to add that, if you are on Mathematica 10 or newer, you can also use the ...


5

volume = Integrate[1, Element[{x, y, z}, ImplicitRegion[Abs[x] + Abs[y] + Abs[z] < 4, {x, y, z}]]] (*256/3*) ContourPlot3D[Abs[x] + Abs[y] + Abs[z] == 4, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}]


6

It think it is nice to know that with latest Computational Geometry it is very simple - just a an orthogonal RegionProduct. R2 = MeshRegion[area, Polygon[Range[Length[area]]]]; R3 = RegionProduct[R2, Line[{{0.}, {500.}}]]; Now you can for example: RegionMeasure[R3] or DiscretizeRegion[R3]


2

Another way with rectangular polygons on the sides: bottom = PadRight[area, {Automatic, 3}, 0]; top = PadRight[area, {Automatic, 3}, 400]; Graphics3D[{Opacity[0.7], EdgeForm[], Polygon[Join[ {bottom, top}, Join[ Partition[bottom, 2, 1, 1], RotateLeft@Reverse@Partition[top // Reverse, 2, 1, 1], 2] ]] } ]


4

You could simply use the function prism from my answer to How can this texture be inserted in the beginning and the end of cylinder?. The advantage is that it also allows you to add textures (optionally), and has vertex normals built in so that the shape appears smooth. Here it is just for fun: l = {{"Directional", Red, ImageScaled[{2, 2, 2}]}, ...


4

I found out that this is basically the same as @kguler's answer, but I want to mention that this can be easily functionized. Borrowing from this question, we can define something similar: Options[Extrude] = Join[ Options[Graphics3D], {Closed -> True, Capped -> True, Color -> Orange}]; Extrude[points_, {zmin_, zmax_}, opts : OptionsPattern[]] := ...


8

topbottom = Graphics3D[{Opacity[.7], Polygon /@ {area1, area2}}]; sides = Graphics3D[{EdgeForm[], Opacity[.7], Polygon[Partition[Join @@ Transpose[{Join[area1, {First@area1}], Join[area2, {First@area2}]}], 3, 1]]}]; Show[topbottom, sides, ImageSize -> 600] Or, put everything in a single Graphics3D: Graphics3D[{Opacity[.7], Polygon ...


0

area = {{0, 452.45658}, {414.75187, 601.63611}, {506.55465, 696.71757}, {832.78241, 686.88155}, {936.06054, 739.34029}, {1103.27276, 719.66826}, {1155.73149, 726.2256}, {1218.02624, 701.63557}, {1281.96032, 686.88155}, {1618.02409, 677.04554}, {1740.97425, 588.52143}, {2040.97264, 465.57127}, {2077.90455, 459.01393}, ...



Top 50 recent answers are included