ConcurrentPlanes::usage="Show that the six planes drawn by the midpoints of the edges of a tetrahedron, perpendicular to the opposite edge, pass through a point. References: Usunáriz Balanzategui, Ubaldo; Usunáriz Sala, Ignacio. Problemas de Geometría; Personal.";
Development:
Midpoints of each edge:
In[]:=
P1={1,1,1};P2={1,-1,-1};P3={-1,1,-1};P4={-1,-1,1};M1=M2=M3=M4=M5=M6=
P1+P2
2
P2+P4
2
P3+P4
2
P1+P3
2
P1+P4
2
P2+P3
2
{1,0,0};
{0,-1,0};
{-1,0,0};
{0,1,0};
{0,0,1};
{0,0,-1};
Director vectors of each edge:
In[]:=
P1={1,1,1};P2={1,-1,-1};P3={-1,1,-1};P4={-1,-1,1};P4-P3P3-P1P2-P1P4-P2P3-P2P4-P1
{0,-2,2};
{-2,0,-2};
{0,-2,-2};
{-2,0,2};
{-2,2,0};
{-2,-2,0};
Plane that starts from M1 with director vector the edge :
P
3
P
4
-2y+2z+D=0;-2(0)+2(0)+D=0;D=0;2y-2z==0;y-z==0;
Plane that starts from M2 with director vector the edge :
P
1
P
3
-2x-2z+D=0;-2(0)-2(0)+D=0;D=0;x+z==0;
Plane that starts from M3 with director vector the edge :
P
1
P
2
-2y-2z+D=0;-2(0)-2(0)+D=0;D=0;y+z==0;
Plane that starts from M4 with director vector the edge :
P
2
P
4
-2x+2z+D=0;-2(0)+2(0)+D=0;D=0;x-z==0;
Plane that starts from M5 with director vector the edge :
P
2
P
3
-2x+2y+D=0;-2(0)+2(0)+D=0;D=0;x-y==0;
Plane that starts from M6 with director vector the edge :
P
1
P
4
-2x-2y+D==0;-2(0)-2(0)+D=0;D=0;x+y==0;
To obtain the coordinates of the point where the planes are concurrent, three planes are taken and in the others the coordinates obtained are verified:
In[]:=
Solve[{y-z==0,x+z==0,y+z==0},{x,y,z}]
{{x0,y0,z0}};
It is verified in the rest of the plans.
In[]:=
gr=Show[eq1=y-z;eq2=x+z;eq3=y+z;eq4=x-z;eq5=x-y;eq6=x+y;{ContourPlot3D[eq1==0,{x,-1,1},{y,-1,1},{z,-1,1},MeshFalse,ContourStyle->{Orange,Opacity[0.3],Specularity[White,40]}],ContourPlot3D[eq2==0,{x,-1,1},{y,-1,1},{z,-1,1},MeshFalse,ContourStyle->{Orange,Opacity[0.3],Specularity[White,40]}],ContourPlot3D[eq3==0,{x,-1,1},{y,-1,1},{z,-1,1},MeshFalse,ContourStyle->{Orange,Opacity[0.3],Specularity[White,40]}],ContourPlot3D[eq4==0,{x,-1,1},{y,-1,1},{z,-1,1},MeshFalse,ContourStyle->{Orange,Opacity[0.3],Specularity[White,40]}],ContourPlot3D[eq5==0,{x,-1,1},{y,-1,1},{z,-1,1},MeshFalse,ContourStyle->{Orange,Opacity[0.3],Specularity[White,40]}],ContourPlot3D[eq6==0,{x,-1,1},{y,-1,1},{z,-1,1},MeshFalse,ContourStyle->{Orange,Opacity[0.3],Specularity[White,40]}],Graphics3D[{Black,Ball[{0,0,0},0.03],Ball[{1,1,1},0.015],Text[Style[Subscript[P,1],14,Bold],{1,1,1},{0,-1.2}],Ball[{1,-1,-1},0.015],Text[Style[Subscript[P,2],14,Bold],{1,-1,-1},{0,-1.2}],Ball[{-1,1,-1},0.015],Text[Style[Subscript[P,3],14,Bold],{-1,1,-1},{0,-1.2}],Ball[{-1,-1,1},0.015],Text[Style[Subscript[P,4],14,Bold],{-1,-1,1},{0,-1.2}],Green,Opacity[0.4],EdgeForm[Thick],Tetrahedron[{{1,1,1},{1,-1,-1},{-1,1,-1},{-1,-1,1}}]}]},AxesLabel->{x,y,z},AxesOrigin{0,0,0},AxesTrue,BoxedFalse,BoxRatiosAutomatic,PlotRangeAll,ViewPoint{1.3,-2.4,2.},ImageSize700]
Out[]=