Tag Info

Hot answers tagged

14

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_} -> ...


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 ...


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", ...


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"]


5

I was trying to do something similar and created a useful solution. This answer uses Mathematica version 10.2.0.0. First define a region, e.g. a sphere region: region = ImplicitRegion[x^2 + y^2 + z^2 <= 10, {x, y, z}]; Now we can generate random points within this region using the function RandomPoint: pts = RandomPoint[region, 20];(*this generates ...


4

Its difficult to work with your question since you don't define your functions and variables but hopefully this example will be enough. Let's first make a table of cuboids with different z values (but using the same z-value within each cuboid so they are still rectangles). This examples uses the same x and y values for every Cuboid for simplicity, but you ...


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).


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}]}, ...


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], ...


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], ...


3

You could just make a function which decides your end colour: colour1[n_] := With[{end = {x[s], y[s], z[s]} /. First@CourbeMagnetique[n] /. s :> Smin[n]}, If[Norm@end < 1, RGBColor[0, 0, 1], RGBColor[1, 1, 1]]] colour3[n_] := With[{end = {x[s], y[s], z[s]} /. First@CourbeMagnetique[n] /. s :> Smax[n]}, If[Norm@end < 1, RGBColor[1, 0, ...


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]


2

Kind of a part answer: It is quite easy to convert a quaternion to a Mathematica RotationMatrix. First normalize the quaternion. The first element will then be the cosine of half the rotation angle. The last 3 elements together describes the axis of rotation. q = Normalize@{1, 1, 1, 1} rm = RotationMatrix[2 ArcCos[First@q], Rest@q]


1

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 -> Green], Graphics3D[Sphere[f[T]/. sol, 0.03]], PlotRange -> All], {T, 0, 1}] ...


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 ...


1

Is ColorFunction what you want? (The input is automatically rescaled from 0 to 1, so Rescale is unnecessary; see also ColorFunctionScaling.) GrapheMagnetique[n_] := ParametricPlot3D[ Evaluate[{x[s], y[s], z[s]} /. CourbeMagnetique[n]], {s, Smin[n], Smax[n]}, PlotStyle -> {Directive[AbsoluteThickness[1]](*,Blue*)}, ColorFunction -> ...


1

Something like ListPlot3D just that I want it to show those cuboids. If you need to place the same shape at multiple points either in 2D or 3D, the best solution is Translate. It can take more than one translation vector as the second argument. Example: pts = RandomReal[10, {20, 3}]; Graphics3D[ Translate[ Cuboid[], pts ] ]



Only top voted, non community-wiki answers of a minimum length are eligible