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