TransWikia.com

Removes edges from 3D plots in a Show

Mathematica Asked by VDF on July 28, 2021

Below I report the following code

BS = Show[
  ParametricPlot3D[{-Sqrt[(5.273711145277359`)^2 - t^2] - 30, x, 
    t}, {t, -5.273711145277359`, 5.273711145277359`}, {x, -11, 11}, 
   PlotStyle -> {Lighter[Blue], Opacity[0.5]}, Boxed -> False, 
   Mesh -> None], 
  Plot3D[-5.273711145277359`, {t, -30, 15}, {x, -11, 11}, 
   RegionFunction -> Function[{x, y, z}, x^2 + y^2 > 100], 
   PlotStyle -> {Lighter[Blue], Opacity[0.5]}, Boxed -> False, 
   Mesh -> None], 
  Plot3D[5.273711145277359`, {t, -30, 15}, {x, -11, 11}, 
   RegionFunction -> Function[{x, y, z}, x^2 + y^2 > 100], 
   PlotStyle -> {Lighter[Blue], Opacity[0.5]}, Boxed -> False, 
   Mesh -> None], Boxed -> False, Axes -> False, PlotRange -> All]

r0 = 1;
[Omega] = 4;
b1[r_] := (1 - 1/[Omega])*r0 + r0^2/([Omega]*r);
z1[r_] := NIntegrate[(t/b1[t] - 1)^(-1/2), {t, 1, r}];
up1 = With[{rMin = r0, rMax = 10}, 
   ParametricPlot3D[{r*Cos[x], r*Sin[x], z1[r]}, {x, 0, 2 Pi}, {r, 
     rMin, rMax}, ColorFunctionScaling -> False, Boxed -> False, 
    Axes -> {False, False, False}, 
    PlotStyle -> {Lighter[Blue], Opacity[0.5]}, Mesh -> None, 
    PlotPoints -> 50]];
dp1 = With[{rMin = r0, rMax = 10}, 
   ParametricPlot3D[{r*Cos[x], r*Sin[x], -z1[r]}, {x, 0, 2 Pi}, {r, 
     rMin, rMax}, ColorFunctionScaling -> False, Boxed -> False, 
    Axes -> {False, False, False}, 
    PlotStyle -> {Lighter[Blue], Opacity[0.5]}, Mesh -> None, 
    PlotPoints -> 50]];

WH = Show[up1, dp1, PlotRange -> All, ImageSize -> 800];
Show[BS, WH, ImageSize -> 800, Boxed -> False, Mesh -> None]

which produces the following 3D plot
enter image description here

I would like to remove the edges of each plot components, having like a one single plot.
Could be possible to have a 3D plot with the meshes matching through the different parts. I tried to use it, but it gives not a nice results, since the components have different geometries.

One Answer

You could use DiscretizeGraphics to turn your Graphics3D into a MeshRegion:

gr = Show[BS, WH, ImageSize -> 800, Boxed -> False, Mesh -> None];
mr=DiscretizeGraphics[gr]

Answered by Daniel Huber on July 28, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP