3
$\begingroup$

I created this shape using Graphics3D and then Export as pdf, but the quality is not homogenous where in some sphere there are black dots. How can I remove that and get a very nice shape? I am using M12.1.1. Win10(64), RAM 8G

ax := 0; az := 2; ay := 0; rs = 0.1; rl = 0.01;
unitCell3D[x_, y_, z_] := {Red, Sphere[{x + ax, y + ay, az}, rs], Red,
   Sphere[{x + ax, y + ay + 2/3 Sin[120 Degree], az}, rs], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax, 
     y + ay + 2/3 Sin[120 Degree], az}}, rl], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax + Cos[30 Degree]/2, 
     y + ay - Sin[30 Degree]/2, az}}, rl], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax - Cos[30 Degree]/2, 
     y + ay - Sin[30 Degree]/2, az}}, rl]}

f2 = Graphics3D[
  Block[{unitVectA = {Cos[120 Degree], Sin[120 Degree], 0}, 
    unitVectB = {1, 0, 0}}, 
   Table[unitCell3D @@ (unitVectA j + unitVectB k), {j, 20}, {k, 
     20}]], PlotRange -> {{-0.1, 10.128}, {1.3, 13.0}, {-0.3, 2.3}}, 
  Boxed -> False, Axes -> False]
ax := 0; az := 0; ay := 0;
unitCell3D[x_, y_, z_] := {Blue, Sphere[{x + ax, y + ay, az}, rs], 
  Blue, Sphere[{x + ax, y + ay + 2/3 Sin[120 Degree], az}, rs], Black,
   Cylinder[{{x + ax, y + ay, az}, {x + ax, 
     y + ay + 2/3 Sin[120 Degree], az}}, rl], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax + Cos[30 Degree]/2, 
     y + ay - Sin[30 Degree]/2, az}}, rl], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax - Cos[30 Degree]/2, 
     y + ay - Sin[30 Degree]/2, az}}, rl]}

f1 = Graphics3D[
  Block[{unitVectA = {Cos[120 Degree], Sin[120 Degree], 0}, 
    unitVectB = {1, 0, 0}}, 
   Table[unitCell3D @@ (unitVectA j + unitVectB k), {j, 20}, {k, 
     20}]], PlotRange -> {{-0.1, 10.128}, {1.3, 13.0}, {-0.3, 1.3}}, 
  Boxed -> False, Axes -> False]   

sheet = Show[f2, f1]
Export["F:\\..path..\\sheet.pdf", sheet, 
 ImageResolution -> 1200]  

enter image description here

$\endgroup$
5
$\begingroup$

Adding EdgeForm[None] just before you start the cylinders seems to do the trick for me and all the black dots have gone. Clearly Mathematica has trouble occluding lines and it's possibly a z-fighting issue. Don't forget to apply this to both sets of cylinders - I've only shown the ones connecting the red spheres below:

ax := 0; az := 2; ay := 0; rs = 0.1; rl = 0.01;
unitCell3D[x_, y_, z_] := {Red, Sphere[{x + ax, y + ay, az}, rs], Red,
   Sphere[{x + ax, y + ay + 2/3 Sin[120 Degree], az}, rs], 
  EdgeForm[None], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax, 
     y + ay + 2/3 Sin[120 Degree], az}}, rl], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax + Cos[30 Degree]/2, 
     y + ay - Sin[30 Degree]/2, az}}, rl], Black, 
  Cylinder[{{x + ax, y + ay, az}, {x + ax - Cos[30 Degree]/2, 
     y + ay - Sin[30 Degree]/2, az}}, rl]}

As @Chip Hurst noted, it happens because by default "EdgeDepthOffset" is True which allows the edges of the cylinders to peek through the faces of the spheres. If you add Method -> {"EdgeDepthOffset" -> False} to each of your Graphics3D commands it also removes the artefacts.

| improve this answer | |
$\endgroup$
  • 4
    $\begingroup$ I think this behavior comes from the default setting for "EdgeDepthOffset". $\endgroup$ – Chip Hurst Jul 5 at 16:09
  • $\begingroup$ @flinty, AWESOME! and unexpected:-), Thanks! $\endgroup$ – HD2006 Jul 5 at 16:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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