Tracé 3D de l'intersection de la sphère avec le plan (basique)

Sep 24 2020

Je devrais être en mesure d'obtenir cela à partir de la réponse ici - mais, avec mes excuses, j'ai peur de ne pas pouvoir le comprendre.

J'ai une sphère et un plan comme suit:

x = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}]; 
y = InfiniteLine[{{0, 0, 0}, {0, 1, 0}}]; 
z = InfiniteLine[{{0, 0, 0}, {0, 0, 1}}]; 
plane = InfinitePlane[{{1/2, 0, 0}, {1/2, 1, 0}, {1/2, 0, 1}}]; 
sphere = Sphere[{5, 0, 0}, 10]; 
sphereOrigin = Point[{5, 0, 0}];

Graphics3D[{{Thick, x}, {Thick, y}, {Thick, z}, {Opacity[0.15], 
   plane}, {Opacity[0.15], sphere}, 
     {PointSize[Large], Red, sphereOrigin}}, Boxed -> False]

Ce que je veux, c'est un cercle marquant le contour où la sphère coupe le plan. Je ne veux pas l'ajouter manuellement, car je souhaite peut-être utiliser différentes sphères et différents plans.

Mon problème est que, lorsque j'essaie d'utiliser ContourPlot3D, mes calculs sont confus; alors que si j'essaie d'utiliser, Graphics3Dje ne peux pas comprendre comment générer la ligne de contour.

Je me rends compte qu'il s'agit d'un exemple plus basique d'une question à laquelle on a déjà répondu - mais cela signifie simplement que la réponse la plus sophistiquée est trop complexe pour moi ...

Réponses

4 cvgmt Sep 24 2020 at 13:03

Nous utilisons l'expression implicite de plane. La normale du plan estCross[b-a,c-a]

({x, y, z} - a).Cross[b - a, c - a]==0

Et nous utilisons également l'expression implicite de sphère, voici {5,0,0}le centre de la sphère et 10son rayon.

Norm[{x, y, z} - {5, 0, 0}] - 10==0

Norm[{x, y, z} - {5, 0, 0}] - 10 comme MeshFunction

x = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}];
y = InfiniteLine[{{0, 0, 0}, {0, 1, 0}}];
z = InfiniteLine[{{0, 0, 0}, {0, 0, 1}}];
plane = InfinitePlane[{{1/2, 0, 0}, {1/2, 1, 0}, {1/2, 0, 1}}];


sphere = Sphere[{5, 0, 0}, 10];
sphereOrigin = Point[{5, 0, 0}];

fig = Graphics3D[{{Thick, x}, {Thick, y}, {Thick, z}, {Opacity[0.15], 
     plane}, {Opacity[0.15], sphere}, {PointSize[Large], Red, 
     sphereOrigin}}, Boxed -> False];

{a, b, c} = {{1/2, 0, 0}, {1/2, 1, 0}, {1/2, 0, 1}};
circle3 = 
  ContourPlot3D[({x, y, z} - a).Cross[b - a, c - a] == 0, {x, -15, 
    15}, {y, -15, 15}, {z, -15, 15}, 
   MeshFunctions -> 
    Function[{x, y, z}, Norm[{x, y, z} - {5, 0, 0}] - 10], 
   Mesh -> {{0}}, MeshStyle -> {Thick,Red}, ContourStyle -> None, 
   BoundaryStyle -> None];
Show[fig, circle3]

2 DanielHuber Sep 24 2020 at 14:09

L'utilisation de l'option Maillage, comme indiqué dans le lien, ne fonctionne que des coupes de fourrure parallèles à un plan de coordonnées. Pour les intersections arbitraires:

Vous pouvez obtenir la coupe de vos deux régions par: "RegionIntersection [plan, sphère]". Cependant, ce que vous obtenez n'est pas une primitive graphique. Donc, vous ne pouvez pas simplement l'utiliser dans Graphics3D. Pour en faire quelque chose que Graphics3D peut digérer, vous devez utiliser "DiscretizeRegion" ce qui n'est pas trop évident. Voici votre codé avec la coupe:

x = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}];
y = InfiniteLine[{{0, 0, 0}, {0, 1, 0}}];
z = InfiniteLine[{{0, 0, 0}, {0, 0, 1}}];
plane = InfinitePlane[{{1/2, 0, 0}, {1/2, 1, 0}, {1/2, 0, 1}}];
sphere = Sphere[{5, 0, 0}, 10];
sphereOrigin = Point[{5, 0, 0}];
cut = DiscretizeRegion[RegionIntersection[plane, sphere]];

Graphics3D[{{Thick, x}, {Thick, y}, {Thick, z}, {Opacity[0.15], 
   plane}, {Opacity[0.15], sphere}, {PointSize[Large], Red, cut, 
   sphereOrigin}}, Boxed -> False]

J.M.'sennui Sep 26 2020 at 12:27

Puisque la question a déjà reçu une réponse, permettez-moi de présenter une variante de la réponse de cvgmt qui pourrait être plus lisible:

With[{plane = InfinitePlane[{{1/2, 0, 0}, {1/2, 1, 0}, {1/2, 0, 1}}],
      sphere = Sphere[{5, 0, 0}, 10],
      xAxis = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}],
      yAxis = InfiniteLine[{{0, 0, 0}, {0, 1, 0}}],
      zAxis = InfiniteLine[{{0, 0, 0}, {0, 0, 1}}],
      sphereOrigin = Point[{5, 0, 0}]},
     Show[Graphics3D[{{Thick, xAxis, yAxis, zAxis},
                      {Opacity[0.15], plane, sphere},
                      {Directive[PointSize[Large], Red], sphereOrigin}}], 
          ContourPlot3D[Simplify[{RegionMember[sphere, {x, y, z}], 
                                  RegionMember[plane, {x, y, z}]},
                                 {x, y, z} ∈ Reals] // Evaluate,
                        {x, -5, 15}, {y, -10, 10}, {z, -10, 10}, 
                        BoundaryStyle -> {1 -> None, 2 -> None,
                                          {1, 2} -> {{Red, Tube[0.05]}}}, 
                        Contours -> {0}, ContourStyle -> None, Mesh -> None]]]

Ceci est basé sur la technique présentée à l'origine ici .