In[]:=
innercore=86000.;​​radiationzone=319000.;​​photospherelayer=432000.(*miles*);
In[]:=
{innercore/photospherelayer,radiationzone/photospherelayer}
Out[]=
{0.199074,0.738426}
Squared values:
{0.1990740^2,0.73842^2}
Out[]=
{0.0396305,0.545264}
In[]:=
core1=Graphics3D[{Blue,Sphere[{0,0,0},0.20]}]
In[]:=
radiation2=RegionPlot3D[0.04<=x^2+y^2+z^2<=0.56&&(y-x/16.>=0||y-16.x>=0),​​{x,-2,2},{y,-2,2},{z,-2,2},(*was0.55*)​​PlotPoints->{360,360,360},MaxRecursion2,​​Mesh->None]
In[]:=
convection3=RegionPlot3D[0.55<=x^2+y^2+z^2<=1.0&&(y-x/6.>=0||y-6.x>=0),​​{x,-2,2},{y,-2,2},{z,-2,2},​​PlotPoints->{360,360,360},MaxRecursion2,(*was1*)​​Mesh->None]
In[]:=
(*solarinterior=RegionUnion[radiation2,convection3]*)
In[]:=
photosphere4=RegionPlot3D[1.0<=x^2+y^2+z^2<=1.1&&(y-x/4.>=0||y-4.x>=0),​​{x,-2,2},{y,-2,2},{z,-2,2},​​PlotPoints->{360,360,360},​​PlotStyle->Directive[Specularity[White,40],White],​​Mesh->None]
In[]:=
(*ThreeLayers=Import["C:\\Users\\USER\\Desktop\\ThreeLayers.stl","Graphics3D"]*)
In[]:=
chromosphere5=RegionPlot3D[1.1<=x^2+y^2+z^2<=1.2&&(y-x/1.2>=0||y-1.2x>=0),​​{x,-2,2},{y,-2,2},{z,-2,2},​​PlotPoints->{360,360,360},​​PlotStyle->Directive[Specularity[White,40],Orange],​​Mesh->None]
In[]:=
(*baseset=Graphics3D[{Gray,Rotate[​​Cuboid[{-1.5,-1.5,-1.8},{1.5,1.5,-1.55}],45Degree,{0,0,1}]​​},Method{
"SpherePoints"
{40,30}
}]*)
In[]:=
baseset=Graphics3D[{Gray,Rotate[​​Cuboid[{-1.5,-1.5,-1.8},{1.5,1.5,-1.55}],45Degree,{0,0,1}],PlotPoints->{360,360,360}}]
In[]:=
(*basesetp=MeshRegion[DiscretizeRegion@ImplicitRegion[-1.5<=x<=1.5&&-1.5<=y<=1.5&&-1.8<=z<=-1.55,{x,y,z}]];(*Regionnot3DobjectneedShow???*)​​baseset=Show[Rotate[basesetp,45Degree,{0,0,1}]]*)
In[]:=
tube01=Graphics3D[{Gray,Cylinder[{{0,0,-1.7},{0,0,-0.95}},0.3],PlotPoints->{360,360,360}}]
In[]:=
fieldlines01=ParametricPlot3D[{-0.6(1+Sin[u])-.2,0.6(u/20)-0.1,0.6(1.+​​Cos[u])},{u,4,22},PlotStyleOrange,PlotRangeAll]/.Line[pts_,rest___]:>Tube[pts,0.015,rest]
In[]:=
fieldlines01=ParametricPlot3D[{-0.2(1+Sin[u])-.8,0.4(u/20)+0.1,0.2(1.+​​Cos[u])},{u,4,24},PlotStyleOrange,PlotRangeAll]/.Line[pts_,rest___]:>Tube[pts,0.015,rest]
In[]:=
fieldlines01=ParametricPlot3D[{(-0.2(1+Sin[u]))-.8,0.4(u/20)+0.1,0.2(1.+​​Cos[u])},{u,4,24},PlotStyleOrange,PlotRangeAll]/.Line[pts_,rest___]:>Tube[pts,0.015,rest]
In[]:=
SunModel01=Show[convection3,radiation2,core1,photosphere4,chromosphere5,tube01,baseset,fieldlines01]
In[]:=
(*SunModelzz=Show[convection3](*usedseparatelyandaddlowerlayerstogetthreelayers*)*)
In[]:=
(*Export["C:\\Users\\USER\\Desktop\\SunModel01a.stl",SunModel01]*)
In[]:=
(*Export["C:\\Users\\USER\\Desktop\\SunModel02.stl",SunModel02]*)
(*Earth01=Graphics3D[{White,​​Sphere[{0.8,0.8,-1.55},1./109.]},Method{
"SpherePoints"
{40,30}
}]*)
In[]:=
EarthRegion=ImplicitRegion[(x+.68)^2+(y+.68)^2+(z+1.54)^2(1./107.)^2,{x,y,z}];
In[]:=
Earth01=DiscretizeRegion[EarthRegion]
In[]:=
JupiterRegion=ImplicitRegion[(x+.8)^2+(y+.8)^2+(z+1.55)^2(1./10.)^2,{x,y,z}];
In[]:=
Jupiter01=DiscretizeRegion[JupiterRegion]
In[]:=
(*Jupiter01=Graphics3D[{White,Sphere[{-.8,-.8,-1.54},1./10.]},Method{
"SpherePoints"
{40,30}
}]*)
In[]:=
(*Export["C:\\Users\\USER\\Desktop\\SunModel03.stl",SunModel03]*)

STL Character Printing

https://mathematica.stackexchange.com/questions/128412/strategies-for-creating-3d-text​
​
​https://mathematica.stackexchange.com/questions/147829/rot13-and-upside-down-text-flip-text
TextSizea=10;
TextSizeb=8;
In[]:=
TheText1="The Sun";
In[]:=
TheText2=" Radius - 696 Mm - 432,000 miles";
8 around out size of text:
PadImageBy=6;
Number of layers up:
StackingHeight=20;
In[]:=
rastertext1=Rasterize[Graphics[{Text[Style[TheText1,Bold,TextSizea]]}],"Image"];​​rastertext2=Rasterize[Graphics[{Text[Style[TheText2,Bold,TextSizeb]]}],"Image"];
In[]:=
text1=ColorNegate[ImagePad[ImageCrop[rastertext1],PadImageBy,White]];​​text2=ColorNegate[ImagePad[ImageCrop[rastertext2],PadImageBy,White]];
In[]:=
texta=ImageRotate[text1,45Degree];​​textb=ImageRotate[text2,45Degree];
In[]:=
sttta=Image3D[ConstantArray[texta,StackingHeight]];
In[]:=
stttb=Image3D[ConstantArray[textb,StackingHeight]];
In[]:=
sss2a=ImageMesh[sttta,Method->"DualMarchingCubes",DataRange{{-1,1},{-1,1},{-1.7,-1.5}}];
In[]:=
sss2b=ImageMesh[stttb,Method->"DualMarchingCubes",DataRange{{-1,1},{-1,1},{-1.7,-1.5}}];
In[]:=
sssa=Translate[sss2a,{.75,-.75,0}];
In[]:=
sssb=Translate[sss2b,{.99,-.99,0}];
In[]:=
Show[sssa,sssb]
In[]:=
(*Export["C:\\Users\\USER\\Desktop\\TitleSunModel.stl",ttt,{"STL","BinaryFormat"False}]*)
In[]:=
(*Export["C:\\Users\\USER\\Desktop\\SunModel04.stl",SunModel04]*)

Circular Text

https://mathematica.stackexchange.com/questions/5719/how-can-i-wrap-text-around-a-circle​
​https://mathematica.stackexchange.com/questions/25065/rotating-3d-text
Filled Curve:
In[]:=
text=First[First[ImportString[ExportString[Style[" Radiative Zone ",FontSize52,FontFamily"Geogia"],"PDF"],{"PDF","PageGraphics"},"TextMode""Outlines"]]];​​Table[{150Sin[t]},{t,0,Pi,Pi/4}];​​​​textCZ=First[First[ImportString[ExportString[Style[" Convection Zone ",FontSize52,FontFamily"Geogia"],"PDF"],{"PDF","PageGraphics"},"TextMode""Outlines"]]];​​textCore=First[First[ImportString[ExportString[Style[" Core ",FontSize52,FontFamily"Geogia"],"PDF"],{"PDF","PageGraphics"},"TextMode""Outlines"]]];​​​​Table[{150Sin[t]},{t,0,Pi,Pi/4}];​​middle=BSplineFunction100+0,75
2
,150,75
2
,0;​​bottom=BSplineFunction50+0,75
2
,150,75
2
,0;​​Plot[{middle[t],bottom[t]},{t,0,1}]
In[]:=
​​middle2=BSplineFunction100+0.4*0,75
2
,150,75
2
,0;​​bottom2=BSplineFunction50+0.4*0,75
2
,150,75
2
,0;​​Plot[{middle2[t],bottom2[t]},{t,0,1}]
In[]:=
stretch[x_,t_,f_,g_]:=Rescale[x,{10,60},{f[t],g[t]}];​​banner1=text/.{x_Real,y_Real}x,stretchy,
x
430
,bottom,middle;​​banner2=textCZ/.{x_Real,y_Real}x,stretchy,
x
450
,bottom2,middle2;​​(*banner3=textCore/.{x_Real,y_Real}x,stretchy,
x
430
,bottom,middle;*)​​banner3=textCore;​​​​Graphics[{EdgeForm[Black],Blue,banner1}]
In[]:=
Graphics[{EdgeForm[Black],Blue,banner2}]
In[]:=
Graphics[{EdgeForm[Black],Blue,banner3}]
In[]:=
rastertextr=Rasterize[Graphics[{EdgeForm[Black],Blue,banner1}],"Image"];
In[]:=
rastertextrCZ=Rasterize[Graphics[{EdgeForm[Black],Blue,banner2}],"Image"];
In[]:=
rastertextrCore=Rasterize[Graphics[{EdgeForm[Black],Blue,banner3}],"Image"];
In[]:=
PadImageBy4=4;(*aroundoutsizeoftext*)

Photosphere-Chromosphere

https://mathematica.stackexchange.com/questions/5719/how-can-i-wrap-text-around-a-circle
Around out size of text
Number of layers used in stacking
Generate Photosphere text
Used https://www.nanodlp.com/repair-3d-stl-file/ to repair and used 3DBuilder to Re-repair and then added a small Sun in 3D Builder

CITE THIS NOTEBOOK

3D printer model of the Sun​
by Gilmer Allen Gary​
Wolfram Community, STAFF PICKS, October 09, 2024
​https://community.wolfram.com/groups/-/m/t/3295278