# select points outside the cells in a lattice?

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

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.

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 !

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]


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}

• 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? Sep 8, 2017 at 17:07
• i see you mean the RegionDimension is 2 and should have been three. Is it possible to convert a surface to solid conveniently? Sep 8, 2017 at 17:11
• @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. Sep 8, 2017 at 17:11
• 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? Sep 8, 2017 at 17:13
• @AliHashmi Looks like something to look forward to when you upgrade to 11.2! Sep 8, 2017 at 21:25

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}]]