Hot answers tagged graphics3d
14
Use ShearingTransform:
Graphics3D[{Polygon[{{-1.5, -1.5, 0}, {1.5, -1.5, 0}, {1.5, 1.5,
0}, {-1.5, 1.5, 0}}],
Polygon[{{-1.5, 0, -1.5}, {1.5, 0, -1.5}, {1.5, 0, 1.5}, {-1.5, 0,
1.5}}], Opacity[0.5],
GeometricTransformation[Cylinder[{{-1, 1, 0}, {0.0, 0, 0}}, 0.2],
ShearingTransform[ -Pi/4, {-1, 1, 0}, {1, 1, 0}]],
...
9
Take it in steps:
Extract the coefficients and locations into an appropriate data structure.
Use that data structure to create the graphics.
By examining the FullForm of the original expression, we can cobble a rule to find the key data: the coefficients $c$, $d$, and $-1$ and the offsets to the indexes. First, the expression itself:
s = Subscript;
exp ...
9
Maybe using some Lines to simulate a flare star:
flarerays = Normalize /@ RandomVariate[NormalDistribution[], {500, 3}];
Graphics3D[{
White, Specularity[.1, 10], Sphere[],
Opacity[.1],
Orange,
Line[{{1, 1, 2}, {1, 1, 2} + 10 #}] & /@ flarerays,
Blue,
Line[{{-1, 1, -1}, {-1, 1, -1} + 10 #}] & /@ flarerays
},
Lighting -> {
...
7
At OP's behest:
The easiest approach to see the mesh lines is to remove the EdgeForm[] instruction that causes them not to appear. For instance,
DeleteCases[Import["ExampleData/wrench.obj.gz"], _EdgeForm, ∞]
As SEngstrom suggests, you can also use a replacement rule. If, for instance, you want a thick gray mesh, here's what you can do:
...
7
You can pull out the points by searching for Polygon objects in addHatToL /@ Take[Flatten[Take[LsOnDodecahedron, All]], All]:
p1 = addHatToL/@Take[Flatten[Take[LsOnDodecahedron, All]], All];
surfacepoints = Flatten[Flatten[Cases[Flatten[p1[[#]]],Polygon[m_] ->m], 1]&/@Range[Length[p1]], 1];
surfacepoints will then give you the points on the surface ...
7
The documented (!) TetGenConvexHull can compute the convex hull. Then using a GraphicsComplex will be efficient:
<< TetGenLink`
{coords, incidences} = TetGenConvexHull[pts];
Graphics3D[{EdgeForm[], GraphicsComplex[coords, Polygon[incidences]]}]
6
The (undocumented!) function ComputationalGeometry`Methods`ConvexHull3D[] is up to the task for this particular case:
ComputationalGeometry`Methods`ConvexHull3D[pts, Axes -> None,
Graphics`Mesh`FlatFaces -> False]
6
I will use a slightly different example to demonstrate my method (which is in no way guaranteed to solve the problem perfect but just an approach).
Firt we generate $100$ random cuboids with unique color for each of them, so we can have a bijection colorToIdxRules between the color set colorSet and the indice of the cuboids
numObj = 100; numRay = 50;
...
6
Also not very pretty:
lights = {{"Point", Green, {5, 0, 0}}, {"Point", Red, {0, -5, 0}}};
indicators = Text[Style["*", 50, Bold, #2], #3] & @@@ lights;
Graphics3D[{Sphere[{0, 0, 0}, 3], indicators}, Lighting -> lights]
6
Not very pretty, but:
Graphics3D[{
Gray,
Specularity[3, 5],
Sphere[],
Cuboid[{-10, -10, -2}, {10, 10, -1}],
{ (* light *)
White,
EdgeForm[None],
Glow[Yellow],
Opacity[0.5],
Scale[
Translate[
PolyhedronData["GreatStellatedDodecahedron", "Faces"],
{2, 2, 10}],
3]
}
},
Lighting -> {{"Point", Yellow, {2, 2, ...
6
Although you haven't exactly asked this, you might like to generate your graphic automatically by applying pattern matching on your difference operator. The basic idea is as below:
Clear[i, j, k];
op = Plus @@
MapThread[Subscript[u, i - #1, j - #2, k - #3] &,
RotateRight[{0, -1, 1, 0, 0, 0, 0}, #] & /@ {0, 2, 4}]
Giving $op = ...
6
Some things that might interest you:
dat = RandomReal[{1, 2}, {10, 10}];
ListPlot3D[dat, InterpolationOrder -> 0, Filling -> Bottom, Mesh -> None]
pillar[w_][h1_?NumericQ, {x_, y_}] := pillar[w][{0, h1}, {x, y}]
pillar[w_][{h0_, h1_}, {x_, y_}] := Cuboid[{x - w/2, y - w/2, h0}, {x + w/2, y + w/2, h1}]
Graphics3D[{
Opacity[0.5],
...
6
What about this:
Import["ExampleData/wrench.obj.gz", "PolygonObjects"] // Graphics3D
You can use the FaceForm[None] trick as shown by @J.M. here just as well if you only want the wireframe looks.
6
To show that there's more than one way to skin a cat, here's another primitive-based method, using NURBS surfaces to render a hemisphere:
With[{r = 1},
Graphics3D[{EdgeForm[],
BSplineSurface[Outer[Append[First[#1] #2, Last[#1]] &,
r {{0, 1}, {1, 1}, {1, 0}},
{{1, 0}, {1, 1}, {-1, 1}, ...
5
This peculiar method works in Mathematica versions 7 (thanks, Mr. Wizard!) and 8, but apparently no longer in version 9 (per rm):
Graphics3D[{CapForm["Round"], Tube[{{0, 0, 0}, {0, 0, 0}}, {0, 1}]}, Boxed -> False]
(I know CapForm["Round"] can be omitted, since it's the default; I just wanted to indicate that it's the reason for this behavior.)
...
5
ParametricPlot3D[{Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]},
{u, 0, π}, {v, 0, π},
Mesh -> None,
Boxed -> False,
Axes -> None
]
r = 0.5;
d = {0, 0, 0.5}
sphere = ParametricPlot3D[r {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]} + d,
{u, -π/2, π/2}, {v, -π/2, ...
4
Manipulate[
Show[Plot3D[ RandomReal[{-0.5, 0.5}] UnitStep[(x - a)^2 + (y - b)^2 - 1.5^2],
{x, -3, 3}, {y, -3, 3}, PlotRange -> All],
Graphics3D[Arrow[{{a, b, 0}, {a, b, 1/2}}]]],
{a, -1, 1}, {b, -1, 1}]
4
Not sure if this is what you're after. Anyway:
r = .1;
Graphics3D[{Specularity[White, 10],
Red, Sphere[{0, 0, 0}, r],
Blue, Sphere[{0, 0, 1}, r], Sphere[{1, 0, 0}, r], Sphere[{-1, 0, 0}, r],
Sphere[{0, -1, 0}, r], Sphere[{0, 0, -1}, r],
Green, Sphere[{1, 1, 0}, r], Sphere[{1, ...
4
Update
I got a MatrixRank of 4 with the original approximate data, but with the updated exact data, the rank is 3.
The basic idea is that Orthogonalize will return an orthonormal basis for the subspace spanned by the vectors, along with some zero vectors interspersed. (Orthonormal means unit length vectors that are pairwise perpendicular.) Deleting the ...
3
I am not sure I understand completely what you desire to do - especially the following is not quite clear: when you click on a sphere, how would Manipulate know the depth of the desired point? (due to perspective, this will affect the output)
Then again, Mathematica offers a way to return coordinates with respect to "front and back intercepts with the 3D ...
3
so following my comment you can do this..
dz = .01; i3d =
Image3D[Table[
Image[Rasterize[
Graphics3D[Cylinder[{{0, 0, 0}, {1, 2, 0}}, 1], Boxed -> False,
ViewPoint -> {0, 0, Infinity},
PlotRange -> {All, All, {z - dz, z + dz}}]] ] , {z, -1, 1, dz}]];
ImageData[i3d][[100, 100, 100]]
The problem as QuadraticU noted is your 3D "objects" ...
3
Since no-one has done a RegionPlot3D, I'll do one.
RegionPlot3D[
x^2 + y^2 + z^2 <= 1
&&
z >= 0 ||
(-5 < x < 5) && (-5 < y < 5) && (-0.5 < z < 0),
{x, -2, 2}, {y, -2, 2}, {z, -2, 2},
Mesh -> None,
PlotPoints -> 120,
PlotStyle -> Directive[Orange, Specularity[Yellow, 12], ...
3
Here is another simple way to draw a hemisphere that makes use of the symmetry axis:
hemisphere =
First@RevolutionPlot3D[Sqrt[1 - r^2], {r, 0, 1}, Mesh -> None];
Here you can vary the option PlotPoints if needed, to get a more or less dense polygon mesh.
I also extract the contents of the Graphics3D object before using it. This needs to be done ...
3
Since your are simulating Light, why not use Tube
tube1IncidentAndReflection={{-1,1,0},{0,0,0},{1,1,0}};
tube2IncidentAndRefraction={{-1,1,0},{0,0,0},{.6,-1,0}};
...
3
As Anon suggests, ImageSize is the key. For instance:
BarChart3D[Range[5], ImageSize -> 500]
fixes the size at 500, no matter how many data points it has. You can find this kind of thing out for yourself using the built in help. When you look at the help file for BarChart3D, found by the shortcut ?BarChart3D, you can read "BarChart3D has the same ...
2
Or, to make a bigger point, a solid arrow:
Manipulate[Show[
Plot3D[
RandomReal[{-0.5, 0.5}]*UnitStep[(x - a)^2 + (y - b)^2 - 1.5^2],
{x, -3, 3},
{y, -3, 3},
PlotRange -> All],
Graphics3D[{
White, Specularity[1],
Cylinder[{{a, b, 0}, {a, b, 1/2}}, .2],
Cone[{{a, b, 1/2}, {a, b, 7/8}}, .3]}]],
{a, -1, 1}, {b, -1, 1}]
1
Using whuber's method, we can generate a hemisphere with elevation $\alpha$ and horizon $\theta$ using ContourPlot as follows:
\[Alpha] = 0;
\[Theta] = 0;
normal = Cross[{Cos[\[Theta]], Sin[\[Theta]], 0}, {Cos[\[Alpha]] (-Sin[\[Theta]]), Cos[\[Alpha]] Cos[\[Theta]], Sin[\[Alpha]]}];
ContourPlot3D[x^2 + y^2 + z^2, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, ...
1
Someone may find it useful. I'm sure this be implemented much efficient way in Mathemetica. Below is given two functions for:
checking if the line intersects with a box in 3D - Intersection3DQ
calculating 3D intersection points of a line and a box - Intersection3D
.
Intersection3DQ[p1_List, p2_List, boxMin_List, boxMax_List] := Module[
{c, d, e, ad, ...
Only top voted, non community-wiki answers of a minimum length are eligible
