# Plotting Lines of Intersection of Two Surface

ContourPlot3D[{(2 + a \[Gamma])^2/(2 (-4 + \[Gamma]^2)^2) ==
-(((-1 + r) (-8 + (3 + r) \[Gamma]^2 + a \[Gamma] (-6 + (2 + r) \[Gamma]^2))^2)/(4 (-2 + \[Gamma]^2)^2 (-4 + (1 + r) \[Gamma]^2)^2)),
(-2 + a (-1 + r) \[Gamma] + r \[Gamma]^2)^2/(4 (-2 + \[Gamma]^2) (-4 + (1 + r) \[Gamma]^2)) ==
-(((-1 + r) (2 + a \[Gamma])^2)/(-4 + \[Gamma]^2)^2)},
{\[Gamma], 0, 1}, {a, 0, 1}, {r, 0.4, 1}, PlotLegends -> Automatic]


Knowing the two surface equations in three-dimensional space, how can we quickly draw the intersection line.

Since the two surface equations are relatively complicated, if r is solved, multiple roots will be obtained. At this time, it is also necessary to determine which root is available, so it will be more complicated.

Therefore, I hope to find a faster drawing method.

One way is as below.

reg1 = ImplicitRegion[(2 +
a γ)^2/(2 (-4 + γ^2)^2) == -(((-1 +
r) (-8 + (3 + r) γ^2 +
a γ (-6 + (2 +
r) γ^2))^2)/(4 (-2 + γ^2)^2 (-4 + (1 +
r) γ^2)^2)), {{γ, 0, 1}, {a, 0, 1}, {r,
0.4, 1}}];
reg2 = ImplicitRegion[(-2 + a (-1 + r) γ +
r γ^2)^2/(4 (-2 + γ^2) (-4 + (1 +
r) γ^2)) == -(((-1 +
r) (2 + a γ)^2)/(-4 + γ^2)^2), {{γ, 0,
1}, {a, 0, 1}, {r, 0.4, 1}}];
reg3 = RegionIntersection[reg1, reg2];
Show[DiscretizeRegion[reg3, BaseStyle -> {Thick, Red},
MaxCellMeasure -> 10^-6],
DiscretizeRegion[reg1, BaseStyle -> Yellow, MaxCellMeasure -> 10^-6],
DiscretizeRegion[reg2, BaseStyle -> Cyan, MaxCellMeasure -> 10^-6]]


If we set the range from -1 to 1, the intersection like this.

Just add BoundaryStyle -> {{1, 2} -> {Thick, Red}} to your ContourPlot3D:

Warning: this took close to 5 minutes to compute!

• Yeah, I have no idea why it takes so long! Commented Jun 19, 2021 at 4:55