New answers tagged graphics3d
4
I found a workaround for my specific problem, but I am still interested in other answers which may address the original problem (Most of the credit goes to J.M. of course).
The idea is to extract the MeshCoordinates and MeshCells by hand.
annulus3D[c_?VectorQ, {r1_, r2_}, h_?Positive] /; 0 < r1 < r2 :=
Module[{tt, pts, polys},
tt = RegionProduct[...
2
With little help ListCurvePathPlot allows obtaining a nice-looking and very efficient vector representation:
img = Binarize@Import["https://i.stack.imgur.com/3mWJe.png"];
mc = MorphologicalComponents[img];
imgSize = ImageDimensions[img];
gr = ListCurvePathPlot[
Table[Replace[
Position[mc, i], {i_, j_} :> {j, imgSize[[2]] - i + 1}, {-2}], {...
1
If you remove AxesStyle -> Opacity[0], you can see that the $z$ axis is shown from approximately -30 to 30. Therefore, the image is squeezed (because your forced the BoxRatios to be {1, 1, 1}), and that is why your normal vector do not look perpendicular (even though they are).
Solution 1
Use PlotRange -> {-10, 10} to fix the range of $z$ axis and then ...
3
img = Import["https://i.stack.imgur.com/3mWJe.png"];
mesh = ImageMesh[ColorNegate[img]];
reg = RegionProduct[mesh, Line[{{0.}, {1.}}]]
Export["test.stl", reg]
0
I found the answer to my question in this post: Reduce quality of an imported MeshRegion.
The problem is that the imported STL is too large. I decimated the mesh using MeshLab, and my problem was solved!
6
I'm getting something close by using a combination of Mesh, MeshStyle, BoundaryStyle and Arrow primitives.
downsides:
intersection artifacts between Arrow objects and the solid
bottom part of arrow is not occluded properly
th = 0.0015;
plot = RegionPlot3D[{0.4 < x^2 + y^2 < .5}, {x, -1, 1}, {y, -1,
1}, {z, 0, .1}, Mesh -> False, PlotPoints -&...
8
Histogram3D[CirclePoints[20000], Axes -> False, Boxed -> Bottom,
FaceGrids -> {{0, 0, -1}}]
2
Add WindowClickSelect -> True to CreatePalette.
CreatePalette[
Manipulate[
Plot3D[Sin[x y], {x, 0, 3}, {y, 0, 3}, ColorFunction -> color,
ImageSize -> {480, 480}], {color, {"Rainbow", "NeonColors",
"BlueGreenYellow"}}], WindowFloating -> True, WindowSize -> All,
WindowTitle -> "Nice Plot&...
2
f[x_, y_] := 15 - 2 x + 2 y;
reg1 = Polygon[
Flatten[#, 1] &@{#[[1]], #[[2]],
f[#[[1]], #[[2]]]} & /@ {{-10, -10}, {-10, 10}, {10,
10}, {10, -10}}];
reg2 = Sphere[{1, -1, 2}, 5];
int = DiscretizeRegion@RegionIntersection[reg1, reg2];
Graphics3D[{{Opacity[0.5], Cyan, reg2}, {Red, reg1}, {Yellow,
Thickness[.02], int}}, Boxed -> ...
2
You can extract lines (and other graphics primitives, like points for vertices, and polygons for faces) using MeshPrimitives.
ArrayPlot3D seems to use a convoluted specification consisting of translating a single Cuboid around, but in any case the following seems to work:
ArrayPlot3D[ConstantArray[1, {4, 4, 4}]] /.
Cuboid[a_] :> MeshPrimitives[Cuboid[a],...
1
The answer was given in a comment:
@flinty Many thanks. The problem is solved by changing 3DRenderingMethod to BSPTree. – zrysky Jun 18 '20 at 14:28
16
Update: I have managed to fix the distortion of the polygons, so now only the glow is missing
Update 2: I have added a hacky "glow" to the polygons by adding partially transparent polygons slightly above the white polygons to give them some kind of "volumetric glow"
Update 3: I have tweaked the lighting settings a bit to give the image a ...
5
A possible way.
ParametricPlot3D[{x - y, x + y, Sin[x*y]}, {x, -8, 8}, {y, -8, 8},
Axes -> False, Boxed -> False,
ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][x]],
RegionFunction -> Function[{x, y, z}, x^2 + y^2 <= 36],
MaxRecursion -> 0, Mesh -> None, Background -> Black,
PlotPoints -> 80] /.
...
2
Too long for a comment: I interpret these sorts of questions as a request for brainstorming. Here's how one might tackle the problem of reverse-engineering the colors: let's get every distinct color of the image, and try to identify a simple function to reproduce the non-black colors
img=ImageTake[#, Last@ImageDimensions@# - 200] &@
Import["http://...
1
You could display the datasets as polygons that extend down to z=0.
dat = Join[#, {{#[[-1, 1]], #[[-1, 2]], 0}, {#[[1, 1]], #[[-1, 2]],
0}}] & /@ datatest;
Graphics3D[{{Red,
Polygon[{{-50, 0, 0.1}, {-50, 5, 0}, {320, 5, 0}, {320, 0,
0}}]}, {(*EdgeForm[None]*)
Table[Polygon[i,
VertexColors -> Map[Blend[{Blue, White}, #] &...
Top 50 recent answers are included
