In another recent thread we announced the existence of voxel chess pieces originally painted in MagicaVoxel, but could not access them in Mathematica because of a fail case involving ".vox" file format. The purpose of this memo is to show how files exported to OBJ can be converted back to voxels, and to give away a few more free assets.
Pull down the OBJ files from github, then import and print:
PieceData = Import["~/mathfun/" <> # <> ".obj"] & /@ {"pawn", "rook", "knight",
"bishop", "queen", "king"};
GraphicsGrid[ Partition[Show[Region@#,
Graphics3D[Arrow[{{0, 0, 0}, 6 #}] & /@ IdentityMatrix[3]],
ViewVertical -> {0, 1, 0}, ViewPoint -> {2, 0, 2},
PlotRange -> {{-6, 6}, {-1, 20}, {-6, 6}}] & /@ PieceData, 3]]
Validation data
RegionMember[Region[PieceData[[6]]], {0, 0, 0}]
RegionMember[Region[PieceData[[6]]], {0, 1, 0}]
RegionDimension@Region[PieceData[[6]]]
SolidRegionQ@Region[PieceData[[6]]]
Out[]:= True
Out[]:= False
Out[]:= 2
Out[]:= False
We would rather that this output read T,T,3,T, and are unaware whether or not region management is built out to this capability (?). That leaves us the task of identifying boundaries, surface normals, and putting voxel blocks in place, hopefully with color. Assuming the OBJ file is consistent with a VOX decomposition, we can use preexisting region functions to identify control points on the two-dimensional surface:
BoundaryPoints[GeoOBJ_] := With[{SlabPts = Flatten[
Table[{i/2, j/2, k/2}, {i, -6, 6}, {j, 0, 32}, {k, -6, 6}], 2]},
Select[SlabPts, Element[#, Region[GeoOBJ]] &]]
In this case, we know the size of the slab, the origin of coordinates, and the length of the line element, so we don't need too much automation or corner finding. There are at least two good reasons for using halves in discretization of the slab, but you can think of those for yourself.
To get out square facets, we look for nearest neighbors and next nearest neighbors in the sub lattice found by intersection with whichever GeoOBJ.
ListEdges[BoundaryPts_] := With[{EdgeSet =
Edge[#, Nearest[Complement[BoundaryPts, {#}], #]] & /@
BoundaryPts}, {EdgeSet, Edge[#[[1]],
Nearest[Complement[ BoundaryPts, # /.
Edge[x_, y_] :> Append[y, x]], #[[1]] ] ] & /@ EdgeSet}]
Facet[pt_, nNeighbors_, nnNeighbors_] := MapIndexed[
ReplaceAll[ Flatten[Position[#1, 1/2, 1]], {{x_Integer, y_Integer} :>
Polygon[ {pt, nNeighbors[[x]], nnNeighbors[[#2[[1]] ]],
nNeighbors[[y]] }], _ -> {}}] &,
Outer[EuclideanDistance, nnNeighbors, nNeighbors, 1]]
BoundaryDiscretize[GeoOBJ_] := Union[Flatten[
MapThread[Facet[#1[[1]], #1[[2]], #2[[2]]] &,
ListEdges[BoundaryPoints[GeoOBJ ]] ]]];
AbsoluteTiming[AllFacets = BoundaryDiscretize[#] & /@ PieceData;]
Out[]={48.1591, Null}
It seems to take too long, but we are not yet at the finalization stage of needing to optimize. Actually, we have just started (as C.H. was saying yesterday, sort of). Printing Again:
GraphicsGrid[Partition[Show[Graphics3D[#],
Graphics3D[Arrow[{{0, 0, 0}, 6 #}] & /@ IdentityMatrix[3]],
ViewVertical -> {0, 1, 0}, ViewPoint -> {2, 0, 2}, Boxed -> False,
PlotRange -> {{-6, 6}, {-1, 20}, {-6, 6}}] & /@ AllFacets, 3],
ImageSize -> 500]
These should be relatively easy to color, facet by facet, except that we may still have duplicate facets in the extracted data. If we just print some random coloring, that doesn't matter:
lens = Length /@ AllFacets;
cols = Table[Blend[{Hue[RandomReal[{0, 1}]], Pink}], {#}] & /@ lens;
Show[Graphics3D[Transpose[{cols[[3]], AllFacets[[3]]}]],
Graphics3D[Arrow[{{0, 0, 0}, 6 #}] & /@ IdentityMatrix[3]],
ViewVertical -> {0, 1, 0}, ViewPoint -> {2, 0, 2}, Boxed -> False,
PlotRange -> {{-6, 6}, {-1, 12}, {-6, 6}}, ImageSize -> 700]
Okay this looks too much like a discothèque, so for the sake of simplicity, we next need to refine until the facets of each voxel share the same color. More work to be done in the next few days or weeks, but we seem to be making progress.
