1
$\begingroup$

I want to solve the same question as the one in

Difference (or intersection) of two convex polyhedra

however my two convex polyhedra have two different set of faces f1 and f2, for example, not only one as in the mentioned reference.


I tried to adapt from the metioned reference as following, but Mathematica keeps on running forever with no answer. Can someone see the mistake?

v1 = {{1/2, -(Sqrt[2]/3), 1/Sqrt[6]}, {1/2, Sqrt[2]/3, 1/Sqrt[6]}, {-(1/2), -(Sqrt[2]/3), 1/Sqrt[6]}, {-(1/2), Sqrt[2]/3, 1/Sqrt[6]}, {1/2, -(Sqrt[2]/3), -(1/Sqrt[6])}, {1/2, Sqrt[2]/3, -(1/Sqrt[6])}, {-(1/2), -(Sqrt[2]/3), -(1/Sqrt[6])}, {-(1/2), Sqrt[2]/3, -(1/Sqrt[6])}} 

f1={{8,4,2,6},{8,6,5,7},{8,7,3,4},{4,3,1,2},{1,3,7,5},{2,1,5,6}};

R = Graphics3D@GraphicsComplex[v1, Polygon /@ f1];

v2={{1/6, -(1/(6 Sqrt[2])), -(Sqrt[(3/2)]/2)}, {1/6, -(Sqrt[2]/3), -(1/Sqrt[6])}, {-(1/6), 1/(6 Sqrt[2]), -(Sqrt[(3/2)]/2)}, {-(1/2), 0, -(1/Sqrt[6])}, {-(1/6), -(5/(6 Sqrt[2])), -(1/(2 Sqrt[6]))}, {-(1/2), -(1/(2 Sqrt[2])), -(1/(2 Sqrt[6]))}, {1/2, 0, -(1/Sqrt[6])}, {1/2, -(1/(2 Sqrt[2])), -(1/(2 Sqrt[6]))}, {1/2, 1/(2 Sqrt[2]), -(1/(2 Sqrt[6]))}, {1/2, 1/(2 Sqrt[2]), 1/(2 Sqrt[6])}, {1/2, -(1/(2 Sqrt[2])), 1/(2 Sqrt[6])}, {1/2, 0, 1/Sqrt[6]}, {-(1/6), Sqrt[2]/3, -(1/Sqrt[6])}, {-(1/2), 1/(2 Sqrt[2]), -(1/(2 Sqrt[6]))}, {1/6, 5/(6 Sqrt[2]), -(1/(2 Sqrt[6]))}, {1/6, 5/(6 Sqrt[2]), 1/(2 Sqrt[6])}, {-(1/2), 1/(2 Sqrt[2]), 1/(2 Sqrt[6])}, {-(1/6), Sqrt[2]/3, 1/Sqrt[6]}, {-(1/6), -(5/(6 Sqrt[2])), 1/(2 Sqrt[6])}, {-(1/2), -(1/(2 Sqrt[2])), 1/(2 Sqrt[6])}, {1/6, -(Sqrt[2]/3), 1/Sqrt[6]}, {1/6, -(1/(6 Sqrt[2])), Sqrt[3/2]/2}, {-(1/2), 0, 1/Sqrt[6]}, {-(1/6), 1/(6 Sqrt[2]), Sqrt[3/2]/2}}

f2 = {{2, 1, 3, 4, 6, 5}, {8, 7, 9, 10, 12, 11}, {14, 13, 15, 16, 18, 
17}, {20, 19, 21, 22, 24, 23}, {2, 1, 7, 8}, {4, 3, 13, 14}, {6, 
5, 19, 20}, {10, 9, 15, 16}, {12, 11, 21, 22}, {18, 17, 23, 
24}, {20, 6, 4, 14, 17, 23}, {12, 22, 24, 18, 16, 10}, {21, 19, 5,
 2, 8, 11}, {15, 13, 3, 1, 7, 9}};

V = Graphics3D@GraphicsComplex[v2, Polygon /@ f2]

linePoly[v1_, v2_, f1_, f2_] := Module[{fC = Append[#, #[[1]]] & /@ f1}, 
  {x, y, z} /. NSolve[Or @@ ({x, y, z} ∈ # & /@ 
   MeshPrimitives[MeshRegion[v1, Line /@ fC], 1]) && Or @@ (
   {x, y, z}  ∈ # & /@ MeshPrimitives[MeshRegion[v2, Polygon /@ f2], 2])]
]; 

polysIntersected[v1_, v2_, f1_, f2_] := Union[linePoly[v1, v2, f1, f2], linePoly[v2, v1, f2, f1]]; 

points = polysIntersected[v1, v2, f1, f2] // Chop; 

Show[R, V]
Graphics3D[{PointSize[Large], Red, Point /@ points}];
Show[%, %%] 
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.