0
$\begingroup$

I use the following code (based on the responses in my recent relevant questions) in order to generate randomly distributed unidirectional cylinders in a cylinder of elliptical cross section.

findPoints = 
  Compile[{{n, _Integer}, {low, _Real}, {high, _Real}, {minD, _Real}},
    Block[{data = RandomReal[{low, high}, {1, 2}], k = 1, rv, temp}, 
    While[k < n, rv = RandomReal[{low, high}, 2];
     temp = Transpose[Transpose[data] - rv];
     If[Min[Sqrt[(#.#)] & /@ temp] > minD, data = Join[data, {rv}];
      k++;];];
    data]];

npts = 150;
r = 0.03;
minD = 2.2 r;
low = 0;
high = 1;

ep = With[{a = 2/5, b = 1/2}, 
   BoundaryDiscretizeRegion@
    ParametricRegion[(low + high) {1, 1}/2 + 
      c ({a Cos[t], b Sin[t]} + 
         r Normalize[Cross[D[{a Cos[t], b Sin[t]}, t]]]), {{c, 0, 
       1}, {t, 0, 2 \[Pi]}}]];

SeedRandom[159];
pts = Select[findPoints[npts, low, high, minD], RegionMember[ep, #] &];
g2d = Graphics[{FaceForm@GrayLevel[0.8], 
    EdgeForm@
     Directive[Thickness[0.004], 
      Black], {GrayLevel[0.6], Disk[#, r]} & /@ pts}, 
   PlotRange -> {{low, high}, {low, high}}, 
   Background -> GrayLevel[0.8]];

mask = BoundaryDiscretizeRegion[#, {{-1, 1}, {-1, 1}}, 
     MaxCellMeasure -> {1 -> .02}] &@
   BoundaryDiscretizeRegion[Disk[{0.5, 0.5}, {0.4, 0.5}]];
r2d = DiscretizeGraphics[g2d, MaxCellMeasure -> {1 -> .01}, 
   PlotRange -> All];
inside = RegionIntersection[r2d, mask];

edge = DiscretizeRegion@*Line@*Intersection @@ 
   Round[{Sort /@ 
      MeshPrimitives[RegionIntersection[r2d, mask], 1][[;; , 1]], 
     Sort /@ MeshPrimitives[RegionDifference[r2d, mask], 1][[;; , 
        1]]}, .0001];
points = DiscretizeRegion@*Point@*Intersection @@ 
   Round[{MeshPrimitives[RegionDifference[r2d, mask], 0][[;; , 1]], 
     MeshPrimitives[RegionDifference[mask, r2d], 0][[;; , 1]]}, .0001];

regionProduct[reg_, join_: True, y1_: 0, y2_: 1] := 
  Module[{n = MeshCellCount[reg, 0]}, 
   MeshRegion[
    Join @@ (ArrayFlatten@{{#[[;; , ;; 1]], #2, #[[;; , 2 ;;]]}} &[
         MeshCoordinates@reg, #] & /@ {y1, y2}), {MeshCells[reg, _], 
     MeshCells[reg, _] /. p : {__Integer} :> p + n, 
     If[join, 
      MeshCells[
        reg, _] /. {(Polygon | Line)[
          p_] :> (Polygon@Join[#, Reverse[#, 2] + n, 2] &@
           Partition[p, 2, 1, 1]), 
        Point[p_] :> Line@{p, p + n}}, ## &[]]}]];
mask3d = regionProduct@mask;
inside3d = regionProduct[inside, False];
edge3d = regionProduct@edge;
points3d = regionProduct@points;

toGC[reg_, dim_] := 
  GraphicsComplex[MeshCoordinates@reg, MeshCells[reg, dim]];

Graphics3D[{FaceForm@GrayLevel[0.8], toGC[inside3d, 2], EdgeForm[], 
  toGC[edge3d, 2], toGC[points3d, 1], Lighter@Gray, 
  GeometricTransformation[toGC[mask3d, 2], 
   ScalingTransform[0.999 {1, 1, 1}, RegionCentroid@mask3d]]}, 
 Lighting -> "Neutral", Boxed -> False]

Graphics3D[{FaceForm@GrayLevel[0.8], 
  toGC[regionProduct[RegionBoundary@inside, False], 1], EdgeForm[], 
  toGC[regionProduct@inside, 2], toGC[edge3d, 2], toGC[points3d, 1], 
  Gray, Opacity[0.11], 
  GeometricTransformation[toGC[mask3d, 2], 
   ScalingTransform[0.999 {1, 1, 1} #, RegionCentroid@mask3d] & /@ 
    Range[0, 1, 0.01]]}, Lighting -> "Neutral", Boxed -> False, 
 BaseStyle -> {RenderingOptions -> {"DepthPeelingLayers" -> 100}}]

enter image description here enter image description here

Mathematica freezes for five minutes when it is asked to export these two graphics as .eps and produces (the second image for example) a file of 406 Mb.

(Same time behavior for other formats.)

Am I doing something wrong?

Any ideas for workaround? I need this picture for publication.

$Version

10.3.0 for Linux x86 (64-bit) (October 9, 2015)

$\endgroup$
  • 7
    $\begingroup$ Have you seen mathematica.stackexchange.com/q/1542/131? Opacity tends to bloat EPS/PDF quite badly. Quick fix: Rasterize at high resolution and export to PNG or similar. $\endgroup$ – Yves Klett Nov 18 '15 at 12:41
  • $\begingroup$ I guess this is a duplicate:-)! No I haven't seen it. Too badly because it is the first link for the list of related ones. Thanks for the advice. $\endgroup$ – Dimitris Nov 18 '15 at 12:49
  • $\begingroup$ Shall we then close this as a duplicate? Unless your question differs much, I´d suggest so... (PS: I guess you do composites?). Oh, and it might be good to attribute the code from answers you got previously or link these questions/answers. $\endgroup$ – Yves Klett Nov 18 '15 at 12:50
  • $\begingroup$ Not. I don't think it differs so much. If you wish you can close it as dupicate. I haven't read the whole thread but since the behavior remains still the same after three years this behavior is consireded a feature, buggy or a normal one? It is not clear to me. $\endgroup$ – Dimitris Nov 18 '15 at 12:55
  • 1
    $\begingroup$ @dimitris If someone has new idea on the subject it is better to post it as an answer in the linked thread because the issue is the same. It is better to concentrate relevant answers in one place than have them sprayed over many threads. At the same time your question should not be deleted because it provides additional example of the issue which can be used for testing of the solutions. $\endgroup$ – Alexey Popkov Nov 18 '15 at 13:41