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.

Improve this question
$\endgroup$

2 Answers 2

Reset to default
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

Improve this answer
$\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$ Commented 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]

Improve this answer
$\endgroup$
0

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.