Code:

max = 4;
min = 3/2;
myX = 3;
myY = Sqrt[min^2*(1 - x^2/max^2)] /. x -> myX;
point1 = Graphics[{Red, Point[{myX, myY}]}];
dev = D[Sqrt[min^2*(1 - x^2/max^2)], x] /. x -> myX;
ndev = -dev^(-1);
a = Sqrt[1/(1 + ndev^2)];
b = a*ndev;
x1 = Sqrt[1/(4*(1 + dev^2))];
y1 = x1*dev;
f1[x_] := (((myY + y1) - (myY + b))/((myX + x1) - (myX + a)))*
(x - (myX + a)) + myY + b;
f2[x_] := (((myY + b) - (myY - y1))/((myX + a) - (myX - x1)))*
(x - (myX - x1)) + myY - y1
e1[x_] := Sqrt[min^2*(1 - x^2/max^2)];
xpt = N[x /. First[Solve[f1[x] == e1[x], x]]]
ypt = e1[xpt];
rline = Graphics[Line[{{myX + a, f1[myX + a]},
{xpt, f1[xpt]}}]];
frotate[x_, y_, a_] := {x*Cos[a] - y*Sin[a],
x*Sin[a] + y*Cos[a]};
newrline = Graphics[Line[{frotate[myX + a, f1[myX + a],
alpha], frotate[xpt, f1[xpt], alpha]}]];
xpt2 = N[x /. First[Solve[f2[x] == e1[x], x]]];
ypt = e1[xpt2];
lline = Graphics[Line[{{myX - x1, f2[myX - x1]},
{myX + a, f2[myX + a]}}]];
newlline = Graphics[Line[{frotate[myX - x1, f2[myX - x1],
alpha], frotate[myX + a, f2[myX + a], alpha]}]];
newpoint = Graphics[{Red, Point[frotate[myX, myY, alpha]]}];
c1 = ContourPlot[x^2/max^2 + y^2/min^2 == 1, {x, -5, 5},
{y, -5, 5}, PlotRange -> {{-5, 5}, {-5, 5}},
Axes -> True];
firstplot = Show[{c1, rline, lline, point1}]
alpha = Pi/4;
c2 = ContourPlot[(x*Cos[alpha] + y*Sin[alpha])^2/max^2 +
((-x)*Sin[alpha] + y*Cos[alpha])^2/min^2 == 1,
{x, -5, 5}, {y, -5, 5}, PlotRange -> {{-5, 5}, {-5, 5}},
Axes -> True]
secondplot = Show[{c2, newrline, newlline, newpoint}]
Show[{firstplot, secondplot}]