Rescale Graphics3D in base ai rapporti box

Question

Se traccio una sfera usando Graphics3Dcon BoxRatios->1, ottengo una trama dall'aspetto piacevole:

Show[Graphics3D[{Red, Sphere[{0, 0, 0}, 1]}], BoxRatios -> 1, 
 PlotRange -> {{-4, 4}, {-4, 4}, {-4, 4}}]

Immagine:

Tuttavia, se PlotRangeo BoxRatioscambia, la sfera viene distorta:

Se conosco BoxRatiose PlotRangeprima di tracciare, posso usarlo Ellipsoidper creare qualcosa che appaia sferico in qualsiasi trama 3D:

Domanda: C'è un modo per creare il mio "Oggetto grafico" personalizzato che traccia un ellissoide in 3D che viene ridimensionato in base alle dimensioni del grafico ( BoxRatiose PlotRange) per apparire perfettamente sferico? Vorrei che il mio "Oggetto grafico" si adattasse automaticamente BoxRatiose PlotRangeallo stesso modo in cui PointSizesi adatta automaticamente alla larghezza del grafico senza bisogno di input da parte dell'utente.

Nota: potresti essere curioso del motivo per cui sto facendo questa domanda. Il motivo è che Graphics3D[{PointSize[0.035],Red,Point[{0,0,0}]}]produce un punto in 3D che assomiglia a un disco piatto e vorrei rappresentare i punti in 3D come sfere perfettamente ridimensionate. Spheredi per sé non è una risposta perfetta perché può apparire distorta in base alle dimensioni della trama.

Answer 1

Aggiornamento: mentre attendiamo alcuni futuri aggiornamenti di rilascio Sphereche consentano Offset[o]e Scaled[s]specifichino il raggio (come attualmente avviene per Diske Circle), possiamo utilizzare la post-elaborazione come segue:

Se l'input è un Graphicsoggetto e i valori dell'opzione BoxRatiose PlotRangenon sono noti in anticipo, possiamo estrarli dall'oggetto prima di utilizzarli scaleSphere.

Multicolumn[
 glist = Show[Graphics3D[{Red, Sphere[{0, 0, 0}, 1]}], BoxRatios -> #,
      PlotRange -> #2, 
     PlotLabel -> Row[{"BoxRatios: ", #, "\n  PlotRange: ", #2}], 
     ImageSize -> Medium] & @@@ ratiorangepairs, 2]

ClearAll[postProcess]
postProcess = # /. s_Sphere :> 
     scaleSphere[BoxRatios /. Quiet@AbsoluteOptions[#, BoxRatios], 
       PlotRange@#][s] &;


Multicolumn[#, 2] &[postProcess /@ glist]

Risposta originale:

Con rapporti box e intervalli di grafici noti è possibile utilizzare Scaleper costruire una funzione da elaborare Sphere[...]:

ClearAll[scaleSphere]

scaleSphere[br_, pr_] := Scale[#, Normalize[-Subtract @@@ pr, Max] / br] &;

Esempi:

ratiorangepairs =  Tuples[{{1, {1, 2, 3}}, 
  {{{-4, 4}, {-4, 4}, {-4, 4}}, {{-4, 4}, {-4, 4}, {-1, 1}}}}]; 

Multicolumn[#, 2] &[Show[Graphics3D[{Red, scaleSphere[##]@Sphere[{0, 0, 0}, 1]}], 
    BoxRatios -> #, PlotRange -> #2, 
    PlotLabel -> Row[{"BoxRatios: ", #, "\n  PlotRange: ", #2}], 
    ImageSize -> Medium] & @@@ ratiorangepairs]