Thank you, I’d not seen GraphicsComplex before and it could come in handy in the future. However, as implemented it appears to omit polygons along dimensional faces.
Consequently I built polygon regions directly from the data. This went well and I computed an intersection as a cropping boundary. But the intersection is a BooleanRegion and I haven’t figured out how to extract the intersection polygons or visualize it.
Consequently I built polygon regions directly from the data. This went well and I computed an intersection as a cropping boundary. But the intersection is a BooleanRegion and I haven’t figured out how to extract the intersection polygons or visualize it.
In[]:=
(*339kBfile,38.4minpriorcomputation*)mrsurfs=ToExpression[Import["http://www.tangentvectors.com/data/LABTristimulusMediumResSurfaces.csv"]];
In[]:=
plots=ListPlot3D[#,PlotRangeAll,MeshAll]&/@mrsurfs;cmplxs=Cases[#,_GraphicsComplex,All][[1]]&/@plots;polySurfaces=Polygon[#[[1]],Cases[#,Polygon[pts_]pts,All][[1]]]&/@cmplxs;Print[Graphics3D[#,ImageSizeSmall]&/@polySurfaces];
,
,
,
,
,
Data file metadata:
Data file metadata:
In[]:=
flattened=Flatten[mrsurfs,1];drange={MinMax[flattened[[;;,1]]],MinMax[flattened[[;;,2]]],MinMax[flattened[[;;,3]]]}
Out[]=
{{0.,1.},{-0.792873,0.935502},{-1.12029,0.933885}}
In[]:=
lcount=Length[DeleteDuplicates[mrsurfs[[1,;;,1]]]];acount=Length[DeleteDuplicates[mrsurfs[[1,;;,2]]]];bcount=Length[DeleteDuplicates[mrsurfs[[3,;;,3]]]];{lcount,acount,bcount}
Out[]=
{19,35,41}
The six surfaces defined as point sets:
The six surfaces defined as point sets:
In[]:=
afontSize=11;lfontSize=12;green=ColorData["HTML","Green"];sPlots=ListPointPlot3D[#[[1]],PlotRangedrange,PlotStyle#[[2]],AxesStyle{{Black,afontSize},{Black,afontSize},{Black,afontSize}},AxesLabel{Style["",{Black,lfontSize}],Style["",{Black,lfontSize}],Style["",{Black,lfontSize}]},BoxRatios{1,2,2},ImageSize256]&/@Thread[List[mrsurfs,Table[{h,PointSize[0.0075]},{h,{Red,Red,green,green,Blue,Blue}}]]];Print[sPlots];
*
l
*
a
*
b
,
,
,
,
,
The surfaces as polygon regions:
The surfaces as polygon regions:
In[]:=
laminpoints=GatherBy[Sort[mrsurfs[[1,;;]]],First];laminpolys=RegionUnion[Flatten[Table[Table[{Polygon[{laminpoints[[i,j]],laminpoints[[i+1,j]],laminpoints[[i,j+1]]}],Polygon[{laminpoints[[i,j+1]],laminpoints[[i+1,j]],laminpoints[[i+1,j+1]]}]},{j,1,acount-1}],{i,1,lcount-1}]]];lamaxpoints=GatherBy[Sort[mrsurfs[[2,;;]]],First];lamaxpolys=RegionUnion[Flatten[Table[Table[{Polygon[{lamaxpoints[[i,j]],lamaxpoints[[i+1,j]],lamaxpoints[[i,j+1]]}],Polygon[{lamaxpoints[[i,j+1]],lamaxpoints[[i+1,j]],lamaxpoints[[i+1,j+1]]}]},{j,1,acount-1}],{i,1,lcount-1}]]];
In[]:=
lbminpoints=GatherBy[Sort[mrsurfs[[3,;;]]],First];lbminpolys=RegionUnion[Flatten[Table[Table[{Polygon[{lbminpoints[[i,j]],lbminpoints[[i+1,j]],lbminpoints[[i,j+1]]}],Polygon[{lbminpoints[[i,j+1]],lbminpoints[[i+1,j]],lbminpoints[[i+1,j+1]]}]},{j,1,bcount-1}],{i,1,lcount-1}]]];lbmaxpoints=GatherBy[Sort[mrsurfs[[4,;;]]],First];lbmaxpolys=RegionUnion[Flatten[Table[Table[{Polygon[{lbmaxpoints[[i,j]],lbmaxpoints[[i+1,j]],lbmaxpoints[[i,j+1]]}],Polygon[{lbmaxpoints[[i,j+1]],lbmaxpoints[[i+1,j]],lbmaxpoints[[i+1,j+1]]}]},{j,1,bcount-1}],{i,1,lcount-1}]]];
In[]:=
abminpoints=GatherBy[Sort[mrsurfs[[5,;;]]],#[[2]]&];abminpolys=RegionUnion[Flatten[Table[Table[{Polygon[{abminpoints[[i,j]],abminpoints[[i+1,j]],abminpoints[[i,j+1]]}],Polygon[{abminpoints[[i,j+1]],abminpoints[[i+1,j]],abminpoints[[i+1,j+1]]}]},{j,1,bcount-1}],{i,1,acount-1}]]];abmaxpoints=GatherBy[Sort[mrsurfs[[6,;;]]],#[[2]]&];abmaxpolys=RegionUnion[Flatten[Table[Table[{Polygon[{abmaxpoints[[i,j]],abmaxpoints[[i+1,j]],abmaxpoints[[i,j+1]]}],Polygon[{abmaxpoints[[i,j+1]],abmaxpoints[[i+1,j]],abmaxpoints[[i+1,j+1]]}]},{j,1,bcount-1}],{i,1,acount-1}]]];
In[]:=
Print[Graphics3D[#[[1]],ImageSize#[[2]]]&/@Thread[List[{laminpolys,lamaxpolys,lbminpolys,lbmaxpolys,abminpolys,abmaxpolys},{300,300,300,160,300,128}]]];
,
,
,
,
,
The front cropping boundary for surface #1
The front cropping boundary for surface #1