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