How to make the code related to line and ellipse more concise？

My needs are shown in the picture is.

**1. Calculate the equation after a straight line and an ellipse are simultaneous (eliminate x)

The desired result is:

(b^2 + a^2 k^2) x^2 + 2 a^2 k m x + (-a^2 b^2 + a^2 m^2) == 0

2.Calculating the discriminant of simultaneous equations

The desired result is:

4 a^2 b^2 (b^2 + a^2 k^2 - m^2)

3.Calculate Veda of simultaneous equations (x1+x2, x1 x2, y1+y2, y1 y2, x1 x2+y1 y2, x1 y2+x2 y1)

The desired result is:

-((2 a^2 k m)/(b^2 + a^2 k^2)), (a^2 (-b^2 + m^2))/(b^2 + a^2 k^2)

4.Calculate the chord AB length where the ellipse intersects the line**

The desired result is:

2 Sqrt[1 + k^2] Sqrt[(a^2 b^2 (b^2 + a^2 k^2 - m^2))/(b^2 + a^2 k^2)^2 ]

My own attempts and tips from enthusiastic friends helped write these codes, and I think it can be optimized.

It is better to use the symbols in the picture to represent the corresponding results.

Such as：

x1+x2=-((2 a^2 k m)/(b^2 + a^2 k^2)) and so on

How can we further optimize it? Thank you!

The code is as follows:

eqns = {x^2/a^2 + y^2/b^2 == 1, y == k x + m};
polyex = Apply[Subtract, eqns, {1}];
polys = Numerator[Together[Apply[Subtract, eqns, {1}]]];
xpoly = Collect[Resultant[polys[[1]], polys[[2]], y], x];
xp1 = Collect[xpoly, x, # &, Defer[+##]~Reverse~2 &];

xp = Collect[
Coefficient[xpoly, x^2] x^2 +
Factor@FactorTerms[Coefficient[xpoly, x], x] x +
Select[xpoly, FreeQ[x]], x, # &, Defer[+##]~Reverse~2 &];

eqn = {xp == 0}
discx = Factor[Discriminant[xpoly, x]]
frist = Solve[eqns, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify

thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = -CoefficientList[polyex[[2]], x][[2]];    (*k*)
intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)

area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify

Clear["*"]

eqns = {x^2/a^2 + y^2/b^2 == 1, y == k (x - x0) + y0};

line = eqns[[2]]

ell = eqns[[1]]

pts = SolveValues[{line, ell}, {x, y}];

normalized = First[ell] - Last[ell]

params = {a -> Sqrt[Denominator[Coefficient[normalized, x^2]]],
b -> Sqrt[Denominator[Coefficient[normalized, y^2]]]}

glin = line[[2]] /. params;

gell = b {-1, 1} Sqrt[1 - x^2/a^2] /. params;

gpts = pts /. params;

Plot[{{glin, gell}}, {x, -a, a} /. params,
Epilog -> {Red, PointSize[0.02], Point[gpts]}]

polyex = Apply[Subtract, eqns, {1}];

polys = Numerator[Together[Apply[Subtract, eqns, {1}]]];

xpoly = Collect[Resultant[polys[[1]], polys[[2]], y], x];

xp1 = Collect[xpoly, x, # &, Defer[+##]~Reverse~2 &];

xp = Collect[
Coefficient[xpoly, x^2] x^2 +
Factor@FactorTerms[Coefficient[xpoly, x], x] x +
Select[xpoly, FreeQ[x]], x, # &, Defer[+##]~Reverse~2 &];

eqn = {xp == 0}

discx = Factor[Discriminant[xpoly, x]]   (*discriminant*)

{{x1, y1}, {x2, y2}} = SolveValues[eqns, {x, y}] // FullSimplify;

second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify

thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify

slope = -CoefficientList[polyex[[2]], x][[2]];    (*k*)

intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)

Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)

area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


Code update1：

Clear["Global*"]
eqs = {x^2/a^2 + y^2/b^2 == 1, y == k x + m};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ass = ResourceFunction["EllipseProperties"][ell, {x, y}];
params = {a -> ass["SemimajorAxisLength"],
b -> ass["SemiminorAxisLength"]}
(*params={a->Sqrt[Denominator[Coefficient[normalized,x^2]]],b->Sqrt[\
Denominator[Coefficient[normalized,y^2]]]};*)
glin = line[[2]] /. params;
gell = b {-1, 1} Sqrt[1 - x^2/a^2] /. params;
gpts = pts /. params;
Plot[{{glin, gell}}, {x, -a, a} /. params,
Epilog -> {Red, PointSize[0.02], Point[gpts]}]
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


Code Update2:

Clear["Global*"]
eqs = {x^2/a^2 + y^2/b^2 == 1, y == k x + m};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
(*normalized=First[ell]-Last[ell];*)
ass = ResourceFunction["EllipseProperties"][ell, {x, y}];
(*https://resources.wolframcloud.com/FunctionRepository/resources/\
EllipseProperties*)
params = {a -> ass["SemimajorAxisLength"],
b -> ass["SemiminorAxisLength"]}
(*params={a->Sqrt[Denominator[Coefficient[normalized,x^2]]],b->Sqrt[\
Denominator[Coefficient[normalized,y^2]]]};*)
glin = line[[2]] /. params;
gell = b {-1, 1} Sqrt[1 - x^2/a^2] /. params;
gpts = pts /. params;
Plot[{{glin, gell}}, {x, -a, a} /. params,
Epilog -> {Red, PointSize[0.02], Point[gpts]}]
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


Code Update 3:

Clear["Global*"]
eqs = {x^2/9 + y^2/8 == 1, y == 2 x + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
(*ass=ResourceFunction["EllipseProperties"][ell,{x,y}];*)
(*https://resources.wolframcloud.com/FunctionRepository/resources/\
EllipseProperties*)
(*params={a->ass["SemimajorAxisLength"],b->ass["SemiminorAxisLength"]}\
*)
params = {a -> Sqrt[Denominator[Coefficient[normalized, x^2]]],
b -> Sqrt[Denominator[Coefficient[normalized, y^2]]]};
glin = line[[2]] /. params;
gell = b {-1, 1} Sqrt[1 - x^2/a^2] /. params;
gpts = pts /. params;
Plot[{{glin, gell}}, {x, -a, a} /. params,
Epilog -> {Red, PointSize[0.02], Point[gpts]}]
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]];  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


Code Update4:

Clear["Global*"]
eqs = {x^2/a^2 + y^2/b^2 == 1, y == k  x + m};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
(*ass=ResourceFunction["EllipseProperties"][ell,{x,y}];*)
(*https://resources.wolframcloud.com/FunctionRepository/resources/\
EllipseProperties*)
(*params={a->ass["SemimajorAxisLength"],b->ass["SemiminorAxisLength"]}\
*)
(*params={a->Sqrt[Denominator[Coefficient[normalized,x^2]]],b->Sqrt[\
Denominator[Coefficient[normalized,y^2]]]};*)
(*glin=line[[2]]/. params;
gell=b {-1,1} Sqrt[1-x^2/a^2]/. params;
gpts=pts/. params;
Plot[{{glin,gell}},{x,-a,a}/. \
params,Epilog->{Red,PointSize[0.02],Point[gpts]}]*)
ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[pts]},
PlotLegends -> Placed[eqs, {0.8, 0.15}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}]
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]];  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


Code Update5

Clear["Global*"]
eqs = {x^2/81 + y^2/9 == 1, y == 2 x + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
(*ass=ResourceFunction["EllipseProperties"][ell,{x,y}];*)
(*https://resources.wolframcloud.com/FunctionRepository/resources/\
EllipseProperties*)
(*params={a->ass["SemimajorAxisLength"],b->ass["SemiminorAxisLength"]}\
*)
(*params={a->Sqrt[Denominator[Coefficient[normalized,x^2]]],b->Sqrt[\
Denominator[Coefficient[normalized,y^2]]]};*)
(*glin=line[[2]]/. params;
gell=b {-1,1} Sqrt[1-x^2/a^2]/. params;
gpts=pts/. params;
Plot[{{glin,gell}},{x,-a,a}/. \
params,Epilog->{Red,PointSize[0.02],Point[gpts]}]*)
ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[pts]},
PlotLegends -> Placed[eqs, {0.8, 0.15}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}]
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[Coefficient[xpl, x^2] x^2 +
Factor@FactorTerms[Coefficient[xpl, x], x] x +
Select[xpl, FreeQ[x]], x, # &, Defer[+##]~Reverse~2 &] == 0
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]];  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


Code Update6:

Clear["Global*"]
eqs = {x^2/4 + y^2/3 == 1, y == 2 x + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
Graphics[{{First@p}, {Red, Circle[{0, 0}, {ax, bx}],
Point[{0, 0}]}, {Blue, PointSize[.03], Point[pts]}}, Axes -> True,
AxesLabel -> {x, y}, AxesStyle -> Arrowheads[{0.0, 0.04}],
AspectRatio -> 1]
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[Coefficient[xpl, x^2] x^2 +
Factor@FactorTerms[Coefficient[xpl, x], x] x +
Select[xpl, FreeQ[x]], x, # &, Defer[+##]~Reverse~2 &] == 0
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]];  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


Code Update7:

Clear["Global*"]
eqs = {x^2/4 + y^2/3 == 1, y == 2 x + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
(*Graphics[{{First@p},{Red,Circle[{0,0},{ax,bx}],Point[{0,0}]},{Blue,\
PointSize[.03],Point[pts]}},Axes->True,AxesLabel->{x,y},AxesStyle->\
ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[pts]},
PlotLegends -> Placed[eqs, {0.8, 0.15}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}]
plx = Apply[Subtract, eqs, {1}];
pls = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpl = Collect[Resultant[pls[[1]], pls[[2]], y], x];
Collect[Coefficient[xpl, x^2] x^2 +
Factor@FactorTerms[Coefficient[xpl, x], x] x +
Select[xpl, FreeQ[x]], x, # &, Defer[+##]~Reverse~2 &] == 0
Collect[xpl, x, Simplify];
pl = {% == 0}
discx = Factor[Discriminant[xpl, x]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2,
y1 y2/(x1 x2), (x1 + x2)/2, (y1 + y2)/2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = CoefficientList[line[[2]], x][[2]];    (*k*)
intercept = CoefficientList[line[[2]], x][[1]];  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(x1 + x2)^2 - 4 x1 x2]]    (*AbsAB*)
area = 1/2 Chordlength Sqrt[intercept^2]/Sqrt[slope^2 + 1] //
FullSimplify


The follow code shows how to draw the image of straight line and ellipse. The linear equation is in the form of x=ty+n. The linear equation and the elliptic equation are combined to eliminate the parameter x and obtain a univariate quadratic equation about y.

ClearAll[Evaluate[Context[] <> "*"]]
eqns = {x^2/a^2 + y^2/b^2 == 1, x == t y + n};
polyex = Apply[Subtract, eqns, {1}];
polys = Numerator[Together[Apply[Subtract, eqns, {1}]]];
xpoly = Collect[Resultant[polys[[1]], polys[[2]], x], y]
discx = Factor[Discriminant[xpoly, y]]   (*discriminant*)
frist = Solve[eqns, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = -CoefficientList[polyex[[2]], y][[2]];    (*k*)
intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(y1 + y2)^2 - 4 y1 y2]]    (*AbsAB*)


Code Update1:

ClearAll["*"]
eqs = {x^2/16 + y^2/9 == 1, x == 2 y + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
(*ass=ResourceFunction["EllipseProperties"][ell,{x,y}];
params={a->ass["SemimajorAxisLength"],b->ass["SemiminorAxisLength"]}\
*)(*params={a->Sqrt[Denominator[Coefficient[normalized,x^2]]],b->Sqrt[\
Denominator[Coefficient[normalized,y^2]]]}
glin=line[[2]]/. params
gell=b {-1,1} Sqrt[1-x^2/a^2]/. params;
gpts=pts/. params;*)
(*Hold@ContourPlot[Evaluate@{eqs},{x,-a-1,a+1},{y,-b-0.5,b+0.5},\
PlotLegends->Placed[eqs,{0.8,0.15}],AspectRatio->Automatic,Frame->\
params//ReleaseHold*)
ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[pts]},
PlotLegends -> Placed[eqs, {0.8, 0.15}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}]
polyex = Apply[Subtract, eqs, {1}];
polys = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpoly = Collect[Resultant[polys[[1]], polys[[2]], x], y];
ypl = Collect[xpoly, y, Simplify]
Collect[Coefficient[xpoly, y^2] y^2 +
Factor@FactorTerms[Coefficient[xpoly, y], y] y +
Select[xpoly, FreeQ[y]], y, # &, Defer[+##]~Reverse~2 &] == 0
discx = Factor[Discriminant[xpoly, y]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = -CoefficientList[polyex[[2]], y][[2]];    (*k*)
intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(y1 + y2)^2 - 4 y1 y2]]    (*AbsAB*)


Code Update2:

ClearAll["*"]
eqs = {x^2/16 + y^2/9 == 1, x == 2 y + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
Graphics[{{First@p}, {Red, Circle[{0, 0}, {ax, bx}],
Point[{0, 0}]}, {Blue, PointSize[.03], Point[pts]}}, Axes -> True,
AxesLabel -> {x, y}, AxesStyle -> Arrowheads[{0.0, 0.04}],
AspectRatio -> Automatic]
polyex = Apply[Subtract, eqs, {1}];
polys = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpoly = Collect[Resultant[polys[[1]], polys[[2]], x], y];
ypl = Collect[xpoly, y, Simplify]
Collect[Coefficient[xpoly, y^2] y^2 +
Factor@FactorTerms[Coefficient[xpoly, y], y] y +
Select[xpoly, FreeQ[y]], y, # &, Defer[+##]~Reverse~2 &] == 0
discx = Factor[Discriminant[xpoly, y]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = -CoefficientList[polyex[[2]], y][[2]];    (*k*)
intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(y1 + y2)^2 - 4 y1 y2]]    (*AbsAB*)



Code Update3:

ClearAll["*"]
eqs = {x^2/16 + y^2/9 == 1, x == 2 y + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[pts]},
PlotLegends -> Placed[eqs, {0.8, 0.15}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}]
polyex = Apply[Subtract, eqs, {1}];
polys = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpoly = Collect[Resultant[polys[[1]], polys[[2]], x], y];
ypl = Collect[xpoly, y, Simplify]
Collect[Coefficient[xpoly, y^2] y^2 +
Factor@FactorTerms[Coefficient[xpoly, y], y] y +
Select[xpoly, FreeQ[y]], y, # &, Defer[+##]~Reverse~2 &] == 0
discx = Factor[Discriminant[xpoly, y]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = -CoefficientList[polyex[[2]], y][[2]];    (*k*)
intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(y1 + y2)^2 - 4 y1 y2]]    (*AbsAB*)



Code Update4:

eqs = {x^2/16 + y^2/9 == 1, x == 2 y + 1};
line = eqs[[2]]
ell = eqs[[1]]
pts = SolveValues[{line, ell}, {x, y}];
normalized = First[ell] - Last[ell];
ax = Sqrt[Denominator[Coefficient[normalized, x^2]]]
bx = Sqrt[Denominator[Coefficient[normalized, y^2]]]
p = Plot[y /. Solve[line, y], {x, -ax - 0.5, ax + 0.5}];
pts = SolveValues[{line, ell}, {x, y}]
(*Graphics[{{First@p},{Red,Circle[{0,0},{ax,bx}],Point[{0,0}]},{Blue,\
PointSize[.03],Point[pts]}},Axes->True,AxesLabel->{x,y},AxesStyle->\
ContourPlot[
Evaluate@{eqs}, {x, -ax - 1, ax + 1}, {y, -bx - 0.5, bx + 0.5},
Epilog -> {Red, PointSize[0.02], Point[pts]},
PlotLegends -> Placed[eqs, {0.8, 0.15}], AspectRatio -> Automatic,
Frame -> False, Axes -> True, AxesStyle -> Arrowheads[{0.0, 0.04}],
AxesLabel -> {x, y}]
polyex = Apply[Subtract, eqs, {1}];
polys = Numerator[Together[Apply[Subtract, eqs, {1}]]];
xpoly = Collect[Resultant[polys[[1]], polys[[2]], x], y];
ypl = Collect[xpoly, y, Simplify]
Collect[Coefficient[xpoly, y^2] y^2 +
Factor@FactorTerms[Coefficient[xpoly, y], y] y +
Select[xpoly, FreeQ[y]], y, # &, Defer[+##]~Reverse~2 &] == 0
discx = Factor[Discriminant[xpoly, y]]   (*discriminant*)
frist = Solve[eqs, {x, y}] // FullSimplify;
{{x1, y1}, {x2, y2}} = {x, y} /. frist;
second = {x1 + x2, x1 x2, y1 + y2, y1 y2} // FullSimplify
thrid = {x1 x2 + y1 y2, x1 y2 + x2 y1} // FullSimplify
slope = -CoefficientList[polyex[[2]], y][[2]];    (*k*)
intercept = -CoefficientList[CoefficientList[polyex[[2]], y][[1]],
x][[1]] ;  (*m*)
Chordlength =
FullSimplify[
Sqrt[1 + slope^2] Sqrt[(y1 + y2)^2 - 4 y1 y2]]    (*AbsAB*)

• That is a lot of code! Jan 28 at 19:56
• Every code is updating iteration! Feb 20 at 7:42

This can be written rather shortly:

line = y == k x + m;
ell = x^2/a^2 + y^2/b^2 == 1;
pts = SolveValues[{line, ell}, {x, y}];


To test we choose some parameters and draw a picture:

params = {k -> 1, m -> 1, a -> 2, b -> 1};
glin = line[[2]] /. params;
gell = b {-1, 1} Sqrt[2 - x^2/a^2] /. params;
gpts = pts /. params;
Plot[{{glin, gell}}, {x, -2, 2},
Epilog -> {Red, PointSize[0.02], Point[gpts]}]


• thank you! Your code is very concise and clear. Even the pictures of ellipse and straight line are added. This effect is also what I want. I didn't edit the post clearly before, but now I have edited the post again. There are four specific requirements. Can you help me optimize the code according to these requirements? Jan 24 at 1:51
• An error occurred： line = y == k x + m; ell = x^2/a^2 + y^2/b^2 == 1; pts = SolveValues[{line, ell}, {x, y}]; params = {k -> 2, m -> -1, a -> 2, b -> Sqrt[3]}; glin = line[[2]] /. params; gell = b^2 {-1, 1} Sqrt[1 - x^2/a^2] /. params; gpts = pts /. params; Plot[{{glin, gell}}, {x, -2, 2}, Epilog -> {Red, PointSize[0.02], Point[gpts]}]The image drawn after trying this set of code is incorrect Jan 25 at 3:46
• Calculation error, the equation should be: gell = b {-1, 1} Sqrt[1 - x^2/a^2] /. params; ：） Jan 25 at 4:02
• Sorry, but this is also not correct. I fixed it: b {-1, 1} Sqrt[2 - x^2/a^2] /. params` Jan 25 at 8:27
• ClearAll[Evaluate[Context[] <> ""]] eqns = {x^2/a^2 + y^2/b^2 == 1, x == t y + n}; polyex = Apply[Subtract, eqns, {1}]; polys = Numerator[Together[Apply[Subtract, eqns, {1}]]]; xpoly = Collect[Resultant[polys[[1]], polys[[2]], x], y] discx = Factor[Discriminant[xpoly, y]] (*discriminant) frist = Solve[eqns, {x, y}] // FullSimplify; Jan 27 at 12:05