3
$\begingroup$

I try to replicate the two figures of two intersecting cylinders from here.

I tried

cylinders1 = 
  Graphics3D@{Specularity[White, 20], Red, EdgeForm[], 
    Cylinder[{{-2, 0, 0}, {2, 0, 0}}]};
cylinders2 = 
  Graphics3D@{Specularity[White, 40], Blue, EdgeForm[], 
    Cylinder[{{0, 0, -2}, {0, 0, 2}}]};
Show[{cylinders1, cylinders2}, Boxed -> False]

enter image description here

What should I do in order to get an closer to

enter image description here

(not bother with orientation)?

For the common region RegionPlot3D

RegionPlot3D[
 x^2 + y^2 <= 1 && y^2 + z^2 <= 1, {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
  Mesh -> False, Axes -> True, Boxed -> False, 
 PlotStyle -> Directive[Orange, Specularity[White, 20]], 
 PlotPoints -> 100]

comes handy here but I don't know how to achieve the different coloring shown below.

enter image description here

Thanks.

$\endgroup$

2 Answers 2

4
$\begingroup$

In drawing these Steinmetz solids I tried to use as many of the coding points as I could from Paul Bourke's page where your images come from. He uses PovRay, but the code is human readable even if you can't use that program.

Module[{l = 1.75, viewpoint, cylinders1, cylinders2},
 viewpoint = 1.2 {-1, -1, 1};
 cylinders1 = {Specularity[White, 40], Darker@Darker@Blue, EdgeForm[],
    Cylinder[{{-l/2, 0, 0}, {l/2, 0, 0}}, .4]};
 cylinders2 = {Specularity[White, 20], Darker@Darker@Red, EdgeForm[], 
   Cylinder[{{0, -l/2, 0}, {0, l/2, 0}}, .4]};
 Graphics3D[{cylinders1, cylinders2}, 
  Lighting -> {{"Point", White, viewpoint + {0, 0, 2}}, {"Ambient", 
     RGBColor[0.15, 0.15, 0.15]}}, Boxed -> False, 
  ViewPoint -> viewpoint, Method -> {"CylinderPoints" -> 1000}]]

enter image description here

I tried to use PlotPoints as an option, but it wouldn't take, then I saw LegionMammal978's answer and took that last option off him.

Edit:

To get the second image, you can just use ParametricPlot3D, which renders much faster than RegionPlot3D

ParametricPlot3D[{
  {-Sqrt[1 - z^2], -u Sqrt[1 - z^2], z},
  {Sqrt[1 - z^2], -u Sqrt[1 - z^2], z},
  {-u Sqrt[1 - z^2], - Sqrt[1 - z^2], z},
  {-u Sqrt[1 - z^2], Sqrt[1 - z^2], z}},
 {z, -1, 1}, {u, -1, 1}, Mesh -> None, 
 PlotStyle -> 
  Evaluate[{Specularity[White, 40], Darker@Darker@#, 
      EdgeForm[]} & /@ {Blue, Blue, Red, Red}],
 Boxed -> False, Axes -> False, PlotPoints -> 100]

enter image description here

$\endgroup$
1
  • $\begingroup$ Thank you very much! I was ready to answer the second part (I found the related Steinmetz Solid in mathworld.wolfram.com/SteinmetzSolid.html but you did it first (and of course more elegantly:-)!). $\endgroup$
    – Dimitris
    Nov 30, 2015 at 14:09
4
$\begingroup$

The best I can do:

Graphics3D[{Specularity[White, 10], Darker[Red, 3/4], 
  Cylinder[{{-5/2, 0, 0}, {5/2, 0, 0}}], Specularity[White, 10], 
  Darker[Blue, 3/4], Cylinder[{{0, -5/2, 0}, {0, 5/2, 0}}]}, 
 Boxed -> False, 
 Lighting -> {{"Point", GrayLevel[1/2], {2, -2, 2}}, {"Ambient", 
    White}}, Method -> {"CylinderPoints" -> 1000}]

Just keep tweaking the specularities until you find good enough values.

EDIT: Even closer:

Graphics3D[{Specularity[White, 5], Darker[Blue, 3/4], 
  Cylinder[{{-5/2, 0, 0}, {5/2, 0, 0}}], Specularity[White, 5], 
  Darker[Red, 3/4], Cylinder[{{0, -5/2, 0}, {0, 5/2, 0}}]}, 
 Boxed -> False, 
 Lighting -> {{"Point", GrayLevel[1/2], {2, 2, 2}}, {"Ambient", 
    White}}, Method -> {"CylinderPoints" -> 1000}, 
 ViewPoint -> {2, 2, 2}, ViewVertical -> {0, 0, 1}, 
 ImageSize -> Large]

$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.