Draw two curves and a surface

Question

I'm trying to draw two curves and a surface, where one of the curves is to appear on the surface. Unfortunately the curves are drawn with very few points and appear extremely unclear. Is there a way to make them clear thick lines instead?

Here's the code:
Manipulate[
 ParametricPlot3D[{{Cos[[Phi]] Cos[[Theta]], 
    Sin[[Phi]] Cos[[Theta]], 
    Sin[[Theta]]}, {b0x + 2 brx Cos[[Phi]] + 2 bix Sin[[Phi]], 
    b0y + 2 bry Cos[[Phi]] + 2 biy Sin[[Phi]], 
    b0z + 2 brz Cos[[Phi]] + 
     2 biz Sin[[Phi]]}, {(b0x + 2 brx Cos[[Phi]] + 
       2 bix Sin[[Phi]])/
     Norm[{b0x + 2 brx Cos[[Phi]] + 2 bix Sin[[Phi]], 
       b0y + 2 bry Cos[[Phi]] + 2 biy Sin[[Phi]], 
       b0z + 2 brz Cos[[Phi]] + 2 biz Sin[[Phi]]}], (b0y + 
       2 bry Cos[[Phi]] + 2 biy Sin[[Phi]])/
     Norm[{b0x + 2 brx Cos[[Phi]] + 2 bix Sin[[Phi]], 
       b0y + 2 bry Cos[[Phi]] + 2 biy Sin[[Phi]], 
       b0z + 2 brz Cos[[Phi]] + 2 biz Sin[[Phi]]}], (b0z + 
       2 brz Cos[[Phi]] + 2 biz Sin[[Phi]])/
     Norm[{b0x + 2 brx Cos[[Phi]] + 2 bix Sin[[Phi]], 
       b0y + 2 bry Cos[[Phi]] + 2 biy Sin[[Phi]], 
       b0z + 2 brz Cos[[Phi]] + 2 biz Sin[[Phi]]}]}}, {[Phi], 0, 
   2 [Pi]}, {[Theta], -[Pi], [Pi]}, PlotRange -> {-2, 2}, 
  Mesh -> None, PlotStyle -> Thick, 
  PlotStyle -> Opacity[0.6]], {{b0x, 0}, -5, 5}, {{b0y, 0}, -5, 
  5}, {{b0z, 1}, -5, 5}, {{brx, 1}, -5, 5}, {{bry, 0}, -5, 
  5}, {{brz, 0}, -5, 5}, {{bix, 0}, -5, 5}, {{biy, 1}, -5, 
  5}, {{biz, 0}, -5, 5}]

kglr · Accepted Answer

You can use the option PlotStyle to style each of the three parts separately:

PlotStyle -> {Opacity[.6], EdgeForm[{Opacity[1], Thick, Blue}], 
  EdgeForm[{Opacity[1], Thick, Red}]}

Since the three-argument form of ParametricPlot3D produces polygons (i.e., those lines are not Lines!), you need to set the styles using EdgeForm.

We get a much cleaner picture using the two-argument form of ParametricPlot3D for curves and the three-argument form for surfaces and combine the two with Show:

Manipulate[Show[ParametricPlot3D[{
{b0x + 2 brx Cos[ϕ] + 2 bix Sin[ϕ],  b0y + 2 bry Cos[ϕ] + 2 biy Sin[ϕ], 
   b0z + 2 brz Cos[ϕ] + 2 biz Sin[ϕ]}, 
{(b0x + 2 brx Cos[ϕ] + 2 bix Sin[ϕ])/
    Norm[{b0x + 2 brx Cos[ϕ] + 2 bix Sin[ϕ], b0y + 2 bry Cos[ϕ] + 2 biy Sin[ϕ], 
  b0z + 2 brz Cos[ϕ] + 2 biz Sin[ϕ]}], 
 (b0y + 2 bry Cos[ϕ] + 2 biy Sin[ϕ])/
   Norm[{b0x + 2 brx Cos[ϕ] + 2 bix Sin[ϕ], b0y + 2 bry Cos[ϕ] + 2 biy Sin[ϕ], 
  b0z + 2 brz Cos[ϕ] + 2 biz Sin[ϕ]}], 
 (b0z + 2 brz Cos[ϕ] + 2 biz Sin[ϕ])/
   Norm[{b0x + 2 brx Cos[ϕ] + 2 bix Sin[ϕ], b0y + 2 bry Cos[ϕ] + 2 biy Sin[ϕ], 
  b0z + 2 brz Cos[ϕ] + 2 biz Sin[ϕ]}]}},
  {ϕ, 0, 2 π}, PlotRange -> {-2, 2}, BoxRatios -> 1, 
  PlotStyle -> {Directive[Thickness[.01], Blue], Directive[Thickness[.01], Red]}], 
ParametricPlot3D[{Cos[ϕ] Cos[θ], Sin[ϕ] Cos[θ], Sin[θ]},
  {ϕ, 0, 2 π}, {θ, -π, π}, 
  PlotRange -> {-2, 2}, Mesh -> None, PlotStyle -> Opacity[0.3]]],
{{b0x, 0}, -5, 5}, {{b0y, 0}, -5, 5}, {{b0z, 1}, -5, 5}, 
{{brx, 1}, -5, 5}, {{bry, 0}, -5, 5}, {{brz, 0}, -5, 5},
{{bix, 0}, -5, 5}, {{biy, 1}, -5, 5}, {{biz, 0}, -5, 5}]

Draw two curves and a surface

One Answer

Add your own answers!

Ask a Question