9

ClearAll[points]; points[0,n_]:={{0,0}}; points[d_,n_]:=Flatten[Subdivide[##,d]&@@@ Partition[CirclePoints[d{Sin[π/n],Cos[π/n]},d,n],2,1],1]; n=5;m=6; Graphics3D[{ Table[{Hue[i/m],Sphere[Append[#-{Sin[π/n],Cos[π/n]} i,-i]&/@points[j-1,n],0.1]}, {i,m},{j,i}], Table[{Hue[(i+1)/m,1,1,0.3],Polygon@TransformationFunction[ {{i,0,0,(i-1) Sin[π/n]},{0,...


8

Something to start you out: fig[n_, 1, {c_, h_}] := {{0, 0, 0}} fig[n_, m_, {c_, h_}] := PadRight[Standardize[Flatten[Table[ With[{cp = N[CirclePoints[{0, -c k/2 Csc[π/n]}, {c k/2 Csc[π/n], π/2}, n]]}, Transpose[{1 - Range[k]/k, Range[k]/k}] . # & /@ If[k < m - 1, Partition[Rest[cp], 2, 1], Partition[cp, 2, 1, 1]]], {k, m - ...


6

ClipPlanes is useful here DynamicModule[{vp={1.3,-2.4,2},latitude,longitude}, latitude=Line@Table[{Sin[ϕ]Cos[θ],Sin[ϕ]Sin[θ],Cos[ϕ]},{ϕ,0.,Pi,Pi/10},{θ,0.,2Pi,2Pi/60}]; longitude=Line@Table[{Cos[ϕ]Sin[θ],Sin[ϕ]Sin[θ],Cos[θ]},{ϕ,0.,Pi,Pi/10},{θ,0.,2Pi,2Pi/60}]; Graphics3D[{ (*{Opacity[0.2],Sphere[]},*) AbsoluteThickness[1], {ClipPlanes->Dynamic@Append[vp,0]...


6

ParametricPlot3D[{{x, 1, Sin[x]}, {x, 2, Cos[x]}, {x, 3, Sin[x^2]}}, {x, -5, 5}, PlotStyle -> {Red, Green, Blue}, PlotTheme -> "Detailed"]


6

There are several ways to do this. (BTW you should share minimal complete code of your example for other's to be able to help you efficiently). 1. Publish in Wolfram Cloud Method bottomline: very simple and fast, does not need any software, works in a web browser even on mobile, but requires internet Interactivity you have in Wolfram notebooks, from 3D ...


4

Something like; theta = Pi/4; Graphics3D[{Opacity[0.2], Sphere[], Cone[{{0, 0, Cos[theta]}, {0, 0, 0}}, Sin[theta]], Cone[{{0, 0, -Cos[theta]}, {0, 0, 0}}, Sin[theta]], Cylinder[{{0, 0, -10^-6}, {0, 0, 10^-6}}, 1] }]


3

Bell with fillet I will call the main shape a bell since it reminds me of one. Fillets are a CAD concept to round off sharp edges. We will attempt to create a fillet within Mathematica. To print a 3D object successfully, there are often requirements that the mesh is defect-free. Often the graphics look good, but the mesh may not be watertight or may have ...


2

Sorry for too late to modify the another code. The idea is draw some circle or semicircle in the sector using polar coordinate. R = 10.5; α = 0.05 π;(* 0< 2α < π *) r = 0.5; ϕ = 2 π*Sin[α]; draw2d[k_, θ0_] := With[{ρ0 = 2 k*r}, ParametricPlot[{ρ*Cos[θ], ρ* Sin[θ]}, {ρ, 0, R}, {θ, 0, 2 π*Sin[α]}, MeshFunctions -> Function[{x, ...


2

I've confirmed this is a known regression caused by bug fixes in the option SphericalRegion. Sorry! It is fixed in our nightly build so will make it to whatever our next release is. You can work around it by changing the style of the box instead of setting it to False, as follows: Manipulate[ Graphics3D[{Sphere[]},PlotRange->{{-r,r},{-r,r},{-r,r}},...


1

Set MeshFunctions to $x$ and set $x=-1$,MeshFunctions -> {#1 &}, Mesh -> {{-1}} product1 = RegionPlot3D[(x^3 + y^2 + z^2 <= 1) && ((x - 1.5)^3 + y + .5^3 + z^1/2 <= 1), {x, -1, 3}, {y, -2, 2}, {z, -1.5, 1.5}, PlotPoints -> 50, MaxRecursion -> 4, MeshFunctions -> {#1 &}, Mesh -> {{-1}}, MeshStyle -> ...


1

You can use the excellent splineCircle function from this answer to create your BSplineCurve. Use GeometricTransformation to rotate and translate the tube into position. Show[product1, Graphics3D[{Red, GeometricTransformation[ Tube[splineCircle[{0, 0, 0}, Sqrt[2]], 0.05], TranslationTransform[{-1, 0, 0}] . RotationTransform[π/2, {0, 1, 0}...


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