Tag Info

New answers tagged

1

ListPlot3D[RandomReal[1, {10, 10}], InterpolationOrder -> 3, PlotLegends -> Automatic, DataRange -> {{1, 30}, {1, 30}}, MeshFunctions -> {#3 &}, Mesh -> 5] You can use Plot3D[] and other plotting functions as well.


5

Calculating and specifying ImageSize are some kind of cumbersome. An easier way to do what OP asked would be using the same PlotRange for every plot. The main idea is to plot all graphics with default options, then measure their actual PlotRange with the Charting`get3DPlotRange function described by Michael E2 in his this answer, from which we can then ...


1

@mikuszefski's idea of adjusting the overall height of the pictures, according to the number of spheres was very helpful. The diameter of an icosahedron with n shells (not counting the innermost sphere) is 2r(1+2n). Setting this as the image height, times a factor for magnification (here 150) produces this: Here's the code for this, there might be room for ...


4

Using a specific projection I get this: Row[{Graphics3D[{Opacity[.6], pic1}, ImageSize -> {Automatic, 200}, PlotRangePadding -> None, ViewPoint -> {100, 100, 100}], Graphics3D[{Opacity[.6], pic2}, ImageSize -> {Automatic, 200*5/4}, PlotRangePadding -> None, ViewPoint -> {100, 100, 100}], Graphics3D[{Opacity[.6], pic3}, ...


3

Does it need to be using Row? The problem here is that the size of the sphere within the Graphics3D object depends upon the viewing point, viewing angle, etc. So even if you try to explicitly make the sizes of the two Graphics3D objects proportionally correct, you get this: pic1 = Sphere[{0, 0, 0}, 1]; pic2 = {Sphere[{-1, 0, 0}, 1], Sphere[{1, 0, 0}, 1]}; ...


2

For example: sol = First@ NDSolve[{Θ'[t] == 2 Θ[t] + .1, ϕ'[t] == 1, ϕ[0] == 0, Θ[0] == .1}, {Θ, ϕ}, {t, 0, 1}] f[t_] := {Cos[ϕ[t]] Sin[Θ[t]], Sin[ϕ[t]] Sin[Θ[t]], -Cos[Θ[t]]} Manipulate[Show[ ParametricPlot3D[f[t] /. sol, {t, 0, 1}, PlotStyle -> Transparent], ParametricPlot3D[f[t] /. sol, {t, 0, T}, PlotStyle -> {Thick, ...


15

data = Import["orbit3d.out", "Table"]; (* Your Table is not needed; you can use [[...]] instead *) (*d=Table[{data[[i,2]],data[[i,3]],data[[i,4]]},{i,1,Length[data]}];*) d = data[[All, 2 ;; 4]]; l = Line[d]; (* Projections on bounding box *) lz = l /. {x_, y_, z_} -> {x, y, -5.5}; ly = l /. {x_, y_, z_} -> {x, 5.5, z}; lx = l /. {x_, y_, z_} -> ...


3

Expanding on comment from Guess who it is, I think he pretty much had it nailed but instead of mapping onto pts I believe you need to use Range[Length[pts]]. GraphicsComplex will use the point number to indicate the position of the graphic object. With[ { pts = {{1, -1, 1}, {0, 0, 0}, {1, 1, 1}, {0, 0, 2}, {-1, 0, 1}} }, Graphics3D[{ Opacity[0.5], ...


7

I consider this question pretty much answered by @MarcoB, as follows: Mathematica 10 apparently forces rasterization by default when exporting 3D graphics to PDF, even when one adds the option "AllowRasterization" -> False to Export. The only way to disable it is to use the Inset workaround suggested by Jens: Export["PDFTestExport.pdf", ...


3

In order to study that region where you get the defect try f[t_] := {20 Cos[ t] - ((837 + 800 Cos[2 t] - 35 Cos[12 t] + 40 Sqrt[2] Cos[t] Sqrt[801 + Cos[12 t]]) Cos[300 t] + 480 Sin[t] Sin[6 t] Sin[300 t])/(-1637 + 35 Cos[12 t] - 40 Sqrt[2] Cos[t] Sqrt[801 + Cos[12 t]]), 20 Sin[t] + (4 (40 Cos[t] + Sqrt[2] Sqrt[801 + ...


3

Use two Tube[]s: monoTube[{p1_?VectorQ, p2_?VectorQ}, r_?NumericQ] := Module[{h = 1 + $MachineEpsilon^(3/4), pm, t}, t = r/EuclideanDistance[p1, p2]; pm = t p1 + (1 - t) p2; {{CapForm[None], Tube[{p1, pm}, r]}, Tube[{t h p1 + (1 - t h) p2, pm}, {0, r}]}] Graphics3D[monoTube[{{0, 0, 0}, ...


3

monoTube [{pt1_, pt2_}, r_] := {EdgeForm[None], Cylinder[{pt1, pt2}, r], Sphere[pt2, r]} monoTube1[{pt1_, pt2_}, r_] := With[{s = (Norm[pt2 - pt1] - r) Normalize[pt2 - pt1] + pt1}, {EdgeForm[None], Cylinder[{pt1, s}, r], Sphere[s, r]}] Graphics3D[{monoTube [{{0, 0, -1}, {0, 0, 1}}, 1], ...


8

I am glad that you are using Mathematica in your high school project. I think you forgot to mention in your question that the code you posted doesn't actually produce the image you showed; you may also want to mention where you obtained that image. Anyway, since your figure is made up of repeating units, I generated one unit, then translated it multiple ...


4

Filling is not an option for Graphics, One approach is to use a PieChart as a background. angles[t_] := Module[{o = {0, 0}, p = {Cos[t], Sin[t]}, rot}, rot = If[TrueQ[Pi/2 < Mod[t, 2 Pi] < 3 Pi/2], t + Pi, t]; {{Opacity[0.3], Line[{o, p}]}, Rotate[Inset[Style[Row[{t}], FontSize -> 18], p/2], rot]}]; ang = {52, 0, 220, 180, 132, 282, ...


4

I think using circular sectors generated with Disk may be easier: SeedRandom[3] Clear[sector, angles] sector[color_, angle_List] := {color, Disk[{0, 0}, .995, {angle[[1]], angle[[2]]} Degree]} angles[t_] := Module[ {o = {0, 0}, p = {Cos[t], Sin[t]}, rot}, rot = If[TrueQ[Pi/2 < Mod[t, 2 Pi] < 3 Pi/2], t + Pi, t]; {{Opacity[0.3], Line[{o, p}]}, ...


1

It isn't perfectly clear what the desired scope and outcome is. For instance, Truncate will close a hole created in a polyhedron. That's not possible, if we truncate just one vertex of one polygon. If we truncate the right ones on the right polygons, then it could be done. The code below does not handle that case. It's a rather special case and would ...


2

Either Insert[bunny, Opacity[0.5], {1, 1}] or bunny /. Graphics3D[g_, opts___] :> Graphics3D[{Opacity[0.5], g}, opts] will produce this: Or even bunny /. GraphicsComplex[x_, g_, o___] :> GraphicsComplex[x, {Opacity[0.5], g}, o]


6

In version 10.2 there is a new suite of functions that may be helpful: f[x_, y_, z_] := Sin[x/4]*Sin[y/4]*Sin[z/4]; xyzw = Flatten[Table[{x, y, z, f[x, y, z]}, {x, 1, 10}, {y, 1, 10}, {z, 1, 10}] // N, 2]; ListSliceContourPlot3D[xyzw, "CenterPlanes"]


4

There are several options you can try: ContourPlot3D is one way. You can use multiple transparent contours. DensityPlot3D was introduced in version 10.2, but the same effect can be achieved manually using Image3D or Raster3D. The latter has the ClipRange option for cutting away a part (visualizing a cross-section).



Top 50 recent answers are included