ConcurrentHeights::usage="Show that the heights are concurrent in regular tetrahedra and in those with three orthogonal edges (orthocentric). Reference: Personal.";
Development for regular tetrahedron:
Normal vector of each face:
In[]:=
P1={1,1,1};P2={1,-1,-1};P3={-1,1,-1};P4={-1,-1,1};(P3-P1)(P2-P1)(P3-P1)(P4-P3)(P3-P2)(P4-P2)(P4-P1)(P2-P1)
{-4,-4,4};
{-4,4,4};
{4,4,4};
{4,-4,4};
Point of intersection:
In[]:=
Solve====,====,{x,y,z}Solve====,====,{x,y,z}
x+1
-4
y+1
-4
z-1
4
x-1
-4
y+1
4
z+1
4
x-1
4
y-1
4
z-1
4
x+1
4
y-1
-4
z+1
4
{{x0,y0,z0}};
{{x0,y0,z0}};
In[]:=
gr=Show[PI={0,0,0};{Graphics3D[{Black,Ball[PI,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}],Red,Thick,InfiniteLine[{PI,P1}],InfiniteLine[{PI,P2}],InfiniteLine[{PI,P3}],InfiniteLine[{PI,P4}],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[]=
In[]:=
ResourceFunction["SpinShow"][gr,30]
Out[]=
Development for tetrahedron with three orthogonal edges (orthocentric):
The heights of the three faces with orthogonal edges will intersect at point , it only remains to verify the remaining face: plane.
P
1
P
2
P
3
P
4
In[]:=
P2={4,2,3};P3={1,6,3};P4={1,2,15};(P3-P2)(P4-P2)
{48,36,12};
48x+36y+12z+D==0;48(4)+36(2)+12(3)+D==0;D=-300;48x+36y+12z-300==0;4x+3y+z-25==0;
Foot of height of that plane:
In[]:=
Solve4x+3y+z-25==0,====,{x,y,z}
x-1
4
y-2
3
z-3
1
x,y,z;
37
13
44
13
45
13
In[]:=
gr=ShowPP=,,;{Graphics3D[{Red,Thick,InfiniteLine[{P1,PP}],InfiniteLine[{P1,P2}],InfiniteLine[{P1,P3}],InfiniteLine[{P1,P4}],Black,Ball[PI,0.09],Ball[PP,0.06],Text[Style[Subscript[P,p],14,Bold],PP,{0,-1.2}],Ball[{1,2,3},0.06],Text[Style[Subscript[P,1],14,Bold],{1,2,3},{0,-1.2}],Ball[{4,2,3},0.06],Text[Style[Subscript[P,2],14,Bold],{4,2,3},{0,-1.2}],Ball[{1,6,3},0.06],Text[Style[Subscript[P,3],14,Bold],{1,6,3},{0,-1.2}],Ball[{1,2,15},0.06],Text[Style[Subscript[P,4],14,Bold],{1,2,15},{0,-1.2}],Green,Opacity[0.4],EdgeForm[Thick],Tetrahedron[{{1,2,3},{4,2,3},{1,6,3},{1,2,15}}]}]},AxesLabel->{x,y,z},AxesOrigin{0,0,0},AxesTrue,BoxedFalse,BoxRatiosAutomatic,PlotRangeAll,ViewPoint{1.3,-2.4,2.},ImageSize700
37
13
44
13
45
13