0
$\begingroup$

I am creating a honey comb lattice with cells wherein the cells are some distance apart. please see the figure below.

enter image description here

I am using the following lines of code to generate this lattice:

(* initial pts of the cell *)
pts1 = ArrayFlatten[{{N@CirclePoints[6], 0}}];
pts2 = Quiet@Distribute[{{0, 0, 1}} + pts1, List];

(* creates a single cell *)
makeRegion[pts_] := Module[{n = (Range[#]~Partition~(#/2)) &@Length[pts], p, q, r},
p = Take[First[n], 2]~Join~Reverse@Take[Last[n], 2];
q = NestList[1 + # &, p, Length[First[n]] - 2];
r = Through[{First, Last}[First@n]]~Join~
Through[{Last, First}[Last@n]];
MeshRegion[pts, Polygon[Join[n, q, {r}]]]];


(* this creates the final lattice *)
q = Module[{p, origin = {0, 0, 0}, originend = {0, 1.9*6, 1.9}, 
 dispstart = {1.65, 0.95, 0}, dispend =  {-1.9, 1.9*5, 1.9}},
Reap[
 FoldList[Function[{pt, param},
   p = 
    Quiet@Table[
      Distribute[# + {{param[[1, 1]], i + param[[1, 2]], 
            param[[1, -1]]}}, List] & /@ pt,
      {i, param[[2, 1]], param[[2, 2]], param[[2, 3]]}];
   Sow[p]; First[p]], {pts1, pts2},
  {{origin, originend}, 
   Sequence @@ 
    Flatten[Array[{{dispstart, dispend}, {dispstart, 
         originend}} &, {2}], 1],
   {dispstart, dispend}}]]
][[2, 1]];

to create the final region (shown in the picture):

region = Region@*DiscretizeGraphics@Show[a = Flatten[
makeRegion/@ArrayReshape[#, Dimensions[#] /. {x_, y__, z_} :> {x, Times[y], z}] & /@ q]]

Now after creating the lattice i wish to create small particles (points) in the empty spaces between the cells. I create an artificial cylinder to first create arbitrary points and then use RegionMemberto select the points.

enter image description here

pts = RandomPoint[Cylinder[{{4, 4, 0}, {4, 4, 1}}, 5], 1000];
Select[pts, ! RegionMember[region, #] &] // Length
(* 1000 *)

However, I find that the same list of points are returned (nothing gets selected). Am i doing something wrong? How can i select the points that are not enveloped by the cells? Thanks !

$\endgroup$
2
$\begingroup$

Your region is 2-dimensional, not 3-dimensional:

RegionDimension@region

2

(you could also look at the output of RegionMember to see the embedding and region dimensions)

So, only points on the surface of your cells belong to the region.

Update

Perhaps you could use DelaunayMesh instead? Something like:

region = RegionUnion @@ Flatten[
    DelaunayMesh /@ ArrayReshape[#, Dimensions[#] /. {x_,y__,z_} :> {x,Times[y],z}]& /@ q
]

rmQ = RegionMember[region]

enter image description here

Then:

pts = RandomPoint[Cylinder[{{4,4,0},{4,4,1}}, 5], 1000];
Select[pts, Not @* rmQ] //Length

193

Note that using Pick instead of Select is faster:

Select[pts, Not @* rmQ] //Length //AbsoluteTiming
Pick[pts, rmQ[pts], False] //Length //AbsoluteTiming

{0.003719, 193}

{0.001406, 193}

$\endgroup$
  • $\begingroup$ thanks but i am specifying the third dimensions of the points with either a 0 or a 1. I am confused as to why region is not three dimensional in the end? $\endgroup$ – Ali Hashmi Sep 8 '17 at 17:07
  • $\begingroup$ i see you mean the RegionDimension is 2 and should have been three. Is it possible to convert a surface to solid conveniently? $\endgroup$ – Ali Hashmi Sep 8 '17 at 17:11
  • $\begingroup$ @AliHashmi The embedding dimension is 3. It's like the difference between Sphere[] and Ball[]. The first has dimension 2 (it is just the surface), even though it lives in 3 dimensions, while the second has dimension 3. $\endgroup$ – Carl Woll Sep 8 '17 at 17:11
  • $\begingroup$ thanks figured it out. any convenient way to construct solids from closed surfaces? or is there any other way to select points external to the surfaces? $\endgroup$ – Ali Hashmi Sep 8 '17 at 17:13
  • 1
    $\begingroup$ @AliHashmi Looks like something to look forward to when you upgrade to 11.2! $\endgroup$ – Carl Woll Sep 8 '17 at 21:25
1
$\begingroup$

Solution below should work for version 11.1.1 and earlier

As @Carl Woll showed in his answer that the embedding dimension for region in question was 2 and not 3, so i replaced MeshRegion with BoundaryMeshRegion in makeRegion to provide an embedding dimension of 3.

makeRegion[pts_] := 
Module[{n = (Range[#]~Partition~(#/2)) &@Length[pts], p, q, r},
p = Take[First[n], 2]~Join~Reverse@Take[Last[n], 2];
q = NestList[1 + # &, p, Length[First[n]] - 2];
r = Through[{First, Last}[First@n]]~Join~
Through[{Last, First}[Last@n]];
BoundaryMeshRegion[pts, Polygon[Join[n, q, {r}]]]
]

then i can use:

pts = RandomPoint[Cylinder[{{4, 4, 0}, {4, 4, 1}}, 5], 1000];
fpts = Pick[pts, And @@@ Transpose[Function[x, ! RegionMember[x, #] & /@ pts] /@ a],True];

Show[region, Graphics3D[{Red, Point@fpts}]]

enter image description here

$\endgroup$

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.