7
Slightly changed last example from docs on GeoProjection. There are a few issues, for instance textures have different resolution. If I figure things out I'lll update the answer. But I thought this is a good start for you anyway.
PolyhedronProjection[polyhedron_]:=
Module[{pts3D,center,pts2D,proj,pts2Dprojected,geographics,plotrange,pts2Dscaled,rescale},
...
6
~ 6 years ago, I wrote a little routine for gnomonically projecting a spherical texture onto a polyhedron:
(* Newell's algorithm for face normals *)
newellNormals[pts_List?MatrixQ] := With[{tp = Transpose[pts]},
Normalize[MapThread[Dot, {ListConvolve[{{-1, 1}}, tp, {{2, -1}, {2, -1}}],
ListConvolve[{{1, 1}}, tp, {{-2, ...
answered May 10 at 4:01
6
The "face-clipping" artifacts in your second example are a common issue when rendering coplanar faces:
This problem is called Z-Fighting, and luckily, it has an easy fix:
Barchart[..., Method -> {"RelieveDPZFighting" -> True}]
Here's your code and with a few small changes:
matrix1 = Rescale @ Table[i+j,{i,8},{j,8}]//N;
matrix2 = matrix1+RandomReal[1,{8,...
6
Here is another approach where you convert a region to a RegionImage. Then you can use ImageRotate to rotate about a vector and Image3DProjection to project the image on a plane.
(* Convert Region To RegionImage *)
ri = RegionImage@ExampleData[{"Geometry3D", "SpaceShuttle"}, "Region"];
(* Rotate Image Pi/2 around X *)
rirot = ImageRotate[ri, {π/2, {1, 0, 0}}...
6
Plot3D example:
Plot3D[{
2 Abs@Sin[x] Boole[0 < y < 2],
2 Abs@Cos[x] Boole[2 < y < 4],
4 Abs@Sin[x] Boole[4 < y < 6],
4 Abs@Cos[x] Boole[6 < y < 8],
6 Abs@Sin[x] Boole[8 < y < 10]
},
{x, 0, 2 Pi},
{y, 0, 10},
Filling -> Bottom,
FillingStyle -> Opacity[1],
Mesh -> False,
PlotRange -> {{0, 2 Pi}, {0, ...
4
Update: Combining all steps in a function:
ClearAll[minMax, hybridBarChart]
minMax = Table[f[[1]][{f[[2]][Through@#@x], #2[[1]] < x <= #2[[2]]},
x] &[##], {f, {{NMaxValue, Max}, {NMinValue, Min}}}] &;
hybridBarChart[funcs_, range_, labels_: Automatic, cf_: "Rainbow"][
opts : OptionsPattern[]] := Module[{minmax = minMax[funcs, range]}...
4
Your question is fundamentally not about a 3D object, incidentally.
Binarize the image (called image), then find the number of black pixels, and divide by the total number of pixels:
N[1 - ((1 /.
ComponentMeasurements[a = Binarize[image], "Count"])/(Times @@ ImageDimensions[a]))]
(* 0.246316 *)
4
{dxf, edges, vd} = Import["(...path...)/input.dxf", #] & /@
{"Graphics3D", "LineData", "VertexData"};
edges = UndirectedEdge @@@ edges;
gives
dxf = Graphics3D[{{EdgeForm[], {RGBColor[0., 0., 0.],
{Text[StyleForm["1", FontColor -> RGBColor[1., 0., 0.]], {75., 25., 0.}, {0, 0}],
Text[StyleForm["2", FontColor -> RGBColor[1., 0., 0.]], {115....
4
If we examine the box structure of the output with shift-cmd-e, we can change the value "Tiling" points to.
For the input
Graphics3D[{StippleShading[], Sphere[]}, Boxed -> False, Lighting -> "Accent"]
it's output has boxes
Here's a few choices:
Edit
It looks like we can use the box structure in the initial call:
stipple = SurfaceAppearance["...
4
I'm not quite sure what the reason is, but it looks like neither PlotRange -> All nor PlotRange -> Full are correctly capturing the real plot range. It's especially weird to me since the legend seems to say that the range goes from 0 to 0.25.
First I tried SliceDensityPlot3D with PlotPoints -> 120 and PlotRange -> Full to try and see what was ...
3
This is only a start, but is this within your capabilities/understanding?
a={1,0,-1/Sqrt[2]};b={-1,0,-1/Sqrt[2]};c={0,1,1/Sqrt[2]};d={0,-1,1/Sqrt[2]};
Graphics3D[{Opacity[1/2],
Sphere[a,3/2],Sphere[b,3/2],Sphere[c,3/2],Sphere[d,3/2],
Text["A",a],Text["B",b],Text["C",c],Text["D",d],
Text["AB",(a+b)/2],Text["AC",(a+c)/2],
Text["AD",(a+d)/2],Text["BC",(...
3
Three years after this question was posted, Wolfram introduced, in MMA 12 (2019), an experimental function (MoleculePlot3D) that widens its molecular drawing capabilities.
When it comes to molecular drawing in MMA, one can divide substances into two categories:
1) Those for which ChemicalData contains plotting information.
This is now the case for ...
3
I am not able to evaluate the OP's notebook, as it uses stuff that can't be parsed by version 11.2. Nevertheless, let me show a small demonstration of coloring a dodecahedron and adding lines to it, using the method from this answer, and the built-in PolyhedronData["Dodecahedron"]:
Graphics3D[{Directive[AbsoluteThickness[4], EdgeForm[AbsoluteThickness[4]]], ...
answered May 7 at 9:44
3
As a variant of your first approach, try just randomly shifting the positions of the bars a tiny bit that will be invisible to the human eye but will prevent the rendering collision effect.
The following is just your code (with lines to generate fake data) and just the second Cuboid@@ slightly perturbed
matrix2 = DiagonalMatrix[Table[RandomReal[{0.8, 0.95}]...
2
If matrix1 and matrix2 have non-negative entries, you can also construct WeightedData objects and use Histogram:
SeedRandom[1]
matrix1 = Rescale@Table[i + j, {i, 8}, {j, 8}] // N;
matrix2 = matrix1 + RandomReal[1, {8, 8}]/2;
{wd1, wd2} = WeightedData[Join @@ Array[List, Dimensions @ #],
Join @@ #] & /@ {matrix1, matrix2};
Histogram3D[{wd1, wd2}, ...
2
Is there a way to label half axes like this?
I would make them manually.
Graphics3D[
{Cuboid[{-1/2, -1/2, -1/2}, {1/2, 1/2, 1/2}],
Style[Text["+X->Noth", {3.3, 0, 0}, {-1, 0}], Bold, 16],
Style[Text["-X->South", {-3.3, 0, 0}, {1, 0}], Bold, 16],
Style[Text["Y", {0, 3, 0}], Bold, 16],
Style[Text["Z", {0, 0, 3}], Bold, 16]},
AxesOrigin -> {...
2
No solution yet, but here's a way to get data from the DXF file for a start, including making a graph from the DXF edges and vertices.
I think the best approach to reproduce the labeled edge values is transform the vertex coordinates to undo the effect of perspective.
Start with Import, then click on the dxf mesh region. Use View Options to select the Top ...
2
Here is some code for generating a bipyramid:
With[{n = 100},
Graphics3D[GraphicsComplex[Join[{{0, 0, 1}},
PadRight[CirclePoints[n/2], {Automatic, 3}],
{{0, 0, -1}}],
With[{ed = Partition[Range[2, n/2 + 1], 2, 1, 1]},
...
answered May 17 at 5:17
2
If you want to see inside a 3D object, I recommend that you peal back the object to the depth of interest using Manipulate.
Clear["Global`*"]
w = 0.02; a0 = 1.5; a = {1, 0.9/a0, 0.6/a0};
{R1, R2} = {{-a[[1]] Sqrt[1/4 - (w/(1 - a[[3]]))^2], 0,
w/(1 - a[[3]])}, {a[[1]] Sqrt[1/4 - (w/(1 - a[[3]]))^2], 0,
w/(1 - a[[3]])}};
maxX = 1.2 R2[[1]]; maxY = ...
1
Plot your function for given value c=.5(for example) with the option RegionFunction
pic = Plot3D[ g[p, q, .5] , {p, 0, 1}, {q, 0, 1}, RegionFunction -> Function[{p, q, z}, z <= 1]]
With
points=pic[[1, 1]][[1]]
(*{{7.14286*10^-8, 7.14286*10^-8, 0.500001}, {0.0714286, 7.14286*10^-8,0.64673},
{0.142857, 7.14286*10^-8, 0.753498}, {0.214286,7.14286*...
1
Enter values as strings and convert to expressions.
EDIT: Added Opacity control
Manipulate[
A1 = {-1, 0, 1};
A2 = {Cos[α], Sin[2 α], -2};
With[
{polyw = PolyhedronData[poly, "Polyhedron"]},
Graphics3D[{
PointSize[0.03],
Map[{
RGBColor @@ Abs[#[[2]] // Round],
Text[#[[1]], #[[2]], {1.5, 1.5}],
Point[#[[2]]]} &,
...
1
May be this code could be supportive
vm = {{{0.10402567469787839`, 0.05634724046135078`, 0.,
0.06671318616834762`}, {-0.033304268882567746`,
0.061484804090894324`,
0.09542953968274223`, -0.10079092470343654`}, \
{0.045451481623891156`, -0.08391042761333754`,
0.06992535634444795`, -0.030220722382910785`}, {0.`, 0.`, 0.`,
1.`}}, ...
1
I personally tend to avoid using things like Scale[] when applying transformations to primitives. Instead, I just apply TransformationFunction[] objects directly to primitives, one way or another. As an example,
dod = PolyhedronData["Dodecahedron", "GraphicsComplex"];
ir = PolyhedronData["Dodecahedron", "Inradius"];
sc = ScalingTransform[RootReduce[ir/...
answered May 7 at 14:54
Only top voted, non community-wiki answers of a minimum length are eligible
