12
You can draw Line
Graphics3D[{RandomColor[], PointSize[0.04], Point[pointstoplot],
Black, Dashed, PointSize[0.02], Gray,
Table[{Line[{p, {p[[1]], p[[2]], 0}}],
Point[{p[[1]], p[[2]], 0}]}, {p, pointstoplot}]}]
{p[[1]], p[[2]], 0} defines that the lines end at z=0 plane. You can also do the same thing to other planes as well.
7
Use Cases to extract the GraphicsComplex from the plot:
c1 = RevolutionPlot3D[{t, -1*2 t}, {t, 0, 1}];
gc = Cases[c1, _GraphicsComplex, Infinity];
Now use GeometricTransformation to apply different transformation functions onto the graphics:
Graphics3D[
{
gc,
GeometricTransformation[gc /. _RGBColor :> Red, ReflectionTransform @ {0, ...
6
SeedRandom[1]
pointstoplot = RandomReal[{0, 5}, {10, 3}];
You can use ListPointPlot3D with the option Filling -> Axis:
lpp = ListPointPlot3D[pointstoplot, BoxRatios -> 1,
PlotStyle -> PointSize[0.04], Filling -> Axis,
FillingStyle -> Directive[Thick, Dashed],
ColorFunction -> "Rainbow"];
labels = Graphics3D@MapIndexed[Text[#2[[1]...
5
SeedRandom[1]
lines = Line /@ RandomReal[1, {100, 2, 3}];
intersections = Function[x,
DeleteCases[RegionIntersection[x, #] & /@ lines, _EmptyRegion, All]];
intersectsLinesQ = intersections[#] != {} &;
faces = Polygon /@ RegionBoundary[shape][[1]]
intersectsLinesQ /@ faces
{True, False, True, True, False, False}
facesThatIntersectLines = ...
2
table = Table[If[i^2 + j^2 + z^2 <= 1, 1, 0], {i, -2, 2, 0.1}, {j, -2, 2,
0.1}, {z, -2, 2, 0.1}];
If you want to get the 3D coordinates from positions of 1 in table you can use Position
coords1 = Position[table, 1];
ListPointPlot3D[coords1, BoxRatios -> 1]
Alternatively, you can make table a SparseArray and use the property "NonzeroPositions"...
1
Instead of using 1 and 0 to mark your selected points, you could instead directly generate the point triple that satisfies your condition, and use Nothing otherwise. For example:
ListPointPlot3D[Flatten[Table[If[i^2 + j^2 + z^2 <= 1, {i, j, z}, Nothing],
{i, -2, 2, 0.1}, {j, -2, 2, 0.1}, {z, -2, 2, 0.1}], 2],
...
1
The OP's solution is doing too much work. In fact, this picture can be generated with a single Plot3D[] call, through the judicious use of Min[] and a straightforward ColorFunction construction:
Plot3D[Min[Sqrt[1 - x^2], 1 - y/2], {x, -1, 1}, {y, 0, 2},
ColorFunction -> Function[{x, y, z}, If[(1 - y/2)^2 < 1 - x^2, Blue, Red]],
...
1
ClearAll[fa, fb, fc]
fa[x_] := -x/2 + 1
fb[x_] := Sqrt[1 - x^2]
fc[x_] := Sqrt[x - x^2/4];
You can generate the two red surfaces using a single ParametricPlot3D.
You can use the option RegionFunction instead of making the range of the second parameter depend on the value of the first parameter.
p1 = ParametricPlot3D[{{fb[y], x, y}, {- fb[y], x, y}}, {x, ...
1
Here's a way, but you lose the misaligned mesh lines:
A1 = ParametricPlot3D[{Sqrt[1 - z^2], y, z}, {y, 0, 2}, {z,
0, -y/2 + 1}, PlotStyle -> {Red}, PlotStyle -> Thickness[0.02],
AxesStyle -> Thick, Boxed -> False, AxesOrigin -> {0, 0, 0},
AxesLabel -> {x, y, z}, Mesh -> None, BoundaryStyle -> Green];
A2 = ...
1
I found a solution to my problem.
The code that I ended up with is:
Show[SMTShowMesh["BoundaryConditions" -> True],
Graphics[VectorPlot3D[{Cos[41], -Sin[41], 0}, {x, MeshXmin,
MeshXmax}, {y, MeshYmin, MeshYmax}, {z, MeshZmin, MeshZmax},
Boxed -> False, Axes -> None, VectorPoints -> info,
VectorStyle -> Black, ...
1
The problem is the result of forcing the z-axis to rescale over 200 orders of magnitude asα is varied from -10 to +10. This appears to be beyond what Mathematica's 3D graphics engine can handle. When the range of α is restricted to something reasonable there is no problem. The critical value of α, the value at which the rendering begins to go bad, is at ...
1
ParametricPlot3D[{{s, 0, Sin[s]}, {0, s, Sin[s]}, {s, s, Sin[s]}}, {s, 0, 4 Pi},
PlotStyle -> Tube[.07], ImageSize -> Large]
Only top voted, non community-wiki answers of a minimum length are eligible
