11

For a fixed viewpoint, you can use BoundaryDiscretizeRegion with the option MeshCellStyle to style individual line primitives: pyramid = Pyramid[{{0, 0, 0}, {2, 0, 0}, {2, 2, 0}, {0, 2, 0}, {0, 0, 2}}]; Show[BoundaryDiscretizeRegion[pyramid , MaxCellMeasure -> Infinity, PlotTheme -> "Lines", MeshCellStyle -> {{1, 4|5|8} -> ...


8

We can add custom settings to MaterialShading, use non default Lighting, and add a rounding radius to our block. The various settings in MaterialShading can be changed to give different effects: massoc = Association[{"BaseColor" -> RGBColor[1., 0.75, 0., 1.], "SpecularColor" -> GrayLevel[1], "MetallicCoefficient" -&...


7

To make the hidden line dashed is pretty complicated. However, if you can live with hidden lines drawn only faintly, you may use the option "Opacity" like: base = {{0, 0, 0}, {2, 0, 0}, {2, 2, 0}, {0, 2, 0}}; top = {{0, 0, 2}}; Graphics3D[{EdgeForm[Thickness[0.01]], Opacity[0.8], Triangle[Join[top, #]] & /@ Partition[base, 2, 1, {1, 1}]}]


7

For the input in OP, we can also use RegionPlot3D with the options MeshFunctions and Mesh: cs = Circumsphere[{a, b, c, s}]; Show[RegionPlot3D[cs, PlotStyle -> Opacity[.1, LightBlue], MeshFunctions -> {#2 &, #3 &}, Mesh -> {{{0, Directive[Orange, Thick, Opacity[1]]}}, {{0, Directive[Blue, Thick, Opacity[1]]}}}], Graphics3D[...


7

Circumsphere correctly gave you the sphere that passes through points $A, B, C, S$. To get the circumscribed circles, I suggest using a WFR function Circumcircle3D. a = {0, 0, 0}; b = {7, 0, 0}; c = {65/14, (15 Sqrt[3])/14, 0}; s = {52/7, 0, (12 Sqrt[3])/7}; (* Generate point labels and markers *) pts = {{Red, Point[#[[2]]]}, {Text[#[[1]], #[[2]] + {0, 0, ....


7

ClearAll[f] f[u_, v_] := {1.16^v Cos[v] (1 + Cos[u]), -1.16^v Sin[v] (1 + Cos[u]), -2 1.16^v (1 + Sin[u])} t1 = ExampleData[{"ColorTexture", "WhiteMarble"}]; t2 = ExampleData[{"ColorTexture", "Roof"}]; plotstyle1 = Directive[Specularity[White, 30], FaceForm[Texture[t1], None]]; plotstyle2 = Directive[...


6

Needs["OpenCascadeLink`"]; shape = OpenCascadeShape[Cuboid[{0, 0, 0}, {3, 1, 1}]]; fillet = OpenCascadeShapeFillet[shape, 0.04]; bmesh = OpenCascadeShapeSurfaceMeshToBoundaryMesh[fillet]; Show[bmesh[ "Wireframe"[ "MeshElementStyle" -> Directive[EdgeForm[], FaceForm[MaterialShading[{"Gold", Darker@...


5

From version 12.3 on, there is a new graphics directive called MaterialShading for various materials. Graphics3D[{MaterialShading["Gold"], Cuboid[{0, 0, 0}, {6, 1.2, 1.3}]}, Boxed -> False] However, you will probably have to play around with different lighting settings to achieve a similar result as in the photo.


4

ClearAll[f, functions] f[u_] := {u, (1 - u) Sin[10 u], (1 - u) Cos[10 u]/3}; plotrange = 4; padding = .5; Construct three additional functions replacing $i^{th}$ coordinate of f[u] with a constant corresponding to the plane of projection: functions[u_] := Prepend[f[u]][ MapThread[ReplacePart[f[u], # -> #2 (plotrange + padding)] &, {{1, 2, 3}, ...


4

Use Plot3D with $z = x + iy$. Plot3D[Arg[x + I y], {x, -1, 1}, {y, -1, 1}, ColorFunction -> "Rainbow"]


4

Use "Ambient" lighting option: plot1 = Plot3D[Exp[x + y], {x, 0, 10}, {y, 0, 10}, PlotRange -> All, Lighting -> {"Ambient", White}, ViewPoint -> {-2.883444524117677`, -0.3079985688886338`, 1.7438132233408123`}]


4

To draw the dashed line automatic, we use the method come from https://mathematica.stackexchange.com/a/238191/72111 a = {0, 0, 0}; b = {7, 0, 0}; c = {65/14, (15 Sqrt[3])/14, 0}; s = {52/7, 0, (12 Sqrt[3])/7}; ball = Circumsphere[{a, b, c, s}]; center = RegionCentroid[ball]; reg1 = RegionIntersection[InfinitePlane[{s, a, b}], Circumsphere[{a, b, c, s}]]; ...


2

You could just shift slightly the various elements e.g. rbelow =0.49 ? r = 0.5; rbelow = 0.49; dbelow = {0, 0, -1.5}; rabove = 0.49; dabove = {0, 0, 1.5}; HemisphereBelow = ParametricPlot3D[ rbelow {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]} + dbelow, {u, -\[Pi]/2, \[Pi]/2}, {v, -\[Pi]/2, \[Pi]/2}, PlotPoints -> {25, 25}, PlotStyle -> Blue,...


2

Maybe this result? Show[Graphics3D[{Opacity[.8], Sphere[], Arrow[Tube[{{0, 0, 0}, {0, 0, 1.3}}]]}], ParametricPlot3D[ FromSphericalCoordinates[{r, θ, φ}] /. {{r -> 1, φ -> π/3}, {r -> 1, φ -> π/4}} // Evaluate, {θ, 0, π/2}, PlotStyle -> {Red, Green}], Boxed -> False, ViewPoint -> {3.06, 0.77, 1.19}]


1

Instead of using Translate, simply add the displacement to the center point. First, generate all spheres, and then colour them according to their $x$-coordinate. spheres = Flatten[{ Table[Sphere[{2, 2, 3} + {i, i, Sqrt[2] i}], {i, 0, 2}], Table[Sphere[{2, 2, 3} + {i, i, -Sqrt[2] i}], {i, 1, 2}], Table[Sphere[{-2, -1, -3} + {i, -i, Sqrt[2] i}], {i,...


1

$Version (*12.3.0 for Microsoft Windows (64-bit) (May 10, 2021)*) Try this: dots[x_, y_, z_] := {{MaterialShading["Plastic"]}, EdgeForm[None], Sphere[{x, y, z}, 0.105], Lighting -> "ThreePoint"} With[{Aa = {0, 1, 0}, Bb = {1, 0, 0}}, Graphics3D[Table[dots @@ (Aa j + Bb k), {j, 1, 20}, {k, 1, 20}], Boxed -> False, ...


Only top voted, non community-wiki answers of a minimum length are eligible