Graphing a cylinder packing in 3D

I am trying to graph a cylinder packing using a mathematical software but I am not sure how to do it. I was hoping Mathematica would be able to do it neatly.

I have a point set in the xy plane and a direction vector of the radical axis for each point. I would like to graph it nicely in 3D. I am attaching a photo of a graph that I would like to more or less recreate with my own parameters.

Thank you!

• I don't think your photo attached properly. – MassDefect Feb 26 at 18:21
• @massdefect fixed! Thank you! – Sorfosh Feb 26 at 18:24

Given a set of points and vectors, I don't think it should be too hard to come up with some code to do what you want. Since I don't have your points or vectors, I just wrote an example.

points = Join[{{0, 0}}, CirclePoints[5], 2 CirclePoints[10],
3 CirclePoints[10], 4 CirclePoints[20]];
pts = {#[[1]], #[[2]], 0} & /@ points;
vectors = Table[{0.1, 0.1, 1}, Length[pts]];
vecPt[pt_, vec_, length_] := pt + length*vec


Your cylinders look to me like they're roughly the points on circles of radius 0, 1, 2, 3, and 4, with 1, 5, 10, 10, and 20 points along the circle. That might not be correct but it gets me something that looks like what you have. Since CirclePoints returns an {x, y} point, and I want {x, y, z}, I just set the z-coordinate to be 0. I made a list of vectors (they're all the same vector because I'm laze). Finally, I have a function that gives me the point on the other side of the cylinder given an initial point, a vector direction, and the length of the vector.

Graphics3D[{
Table[
Cylinder[{pts[[i]],
vecPt[pts[[i]], vectors[[i]], Length[pts] - i + 1]}, 0.5],
{i, Length[pts]}
]
}]


Here, I'm just creating a table of cylinders and displaying them with Graphics3D. I vary the length with the position in the table just to show that it can be done. This gets us:

This might not be exactly what you want, but hopefully it helps you get started! Also, changing the colour of the cylinders shouldn't be too difficult given the colour and styling options of Graphics3D.

EDIT:

 m = 5;
d = 32;
\[Theta] = \[Pi]/(3*2^m);
points = Table[{d Cos[k \[Theta]], d Sin[k \[Theta]], 0}, {k, 6*2^m}];
Graphics3D[{
Cylinder[{#, # + {#[[2]], -#[[1]], .4 Sqrt[3] d + 7}}, 0.5] & /@
points
}]


I'm creating your list of points using a Table. The first argument is the point, and the second argument tells it to create up to vary k from 1 to 6*2^m. Then I use Graphics3D and Cylinder to create the graphics. The hashtag puts in the whole point, and #[[1]] takes the x-coordinate. I'm using the point plus the vector to define the second point. I've squashed the z-coordinate a bit (notice the .4 rather than 4) just so that it displays a bit better.

EDIT 2:

If you'd like to be able to range over multiple d values, they can be added to the Table:

m = 5;
\[Theta] = \[Pi]/(3*2^m);
points = Flatten[
Table[{d Cos[k \[Theta]], d Sin[k \[Theta]], 0}, {k, 6*2^m}, {d,
32, 63}], 1];
Graphics3D[{
Cylinder[{#, # + {#[[2]], -#[[1]], 1 Sqrt[3] d + 7}}, 1] & /@
points
}]


I've simply added {d, 32, 63} to the Table. I use Flatten because Table with two sets of iterators will get us a 2D table, and we really just want a list of points. The values 32 and 63 can be set to anything you want. If you'd like to go from 35 to 65 in steps of 5, you could do {d, 35, 65, 5}. The first part is the variable you want to iterate over, the second is the starting number, the third is the final number, and the fourth is the step size. I went to 63 because it gives a cool image:

Note that I'm using 1 in front of the z-coordinate to squash it a bit this time, but you can easily change it back to 4.

• Thank you! I really appreciate it. Could you just tell me what values i need to change to get the proper vectors and points? I am a completely new to Mathematica so it is hard for me to understand what is happening here. In case it matters for your explanation, the point set is defined as follows. Let $d\geq 32$ and $m$ be a unique $m$ such that $2^m\leq d<2^{m+1}$. Now define $\theta=\frac{\pi}{3*2^m}$ then the point set is $A=\{(d\cos(k\theta),d\sin(k\theta),0): k=1,2,...,6*2^m\}$. The vector for each point is $<y,-x,4\sqrt{3}d+7>$. Obviously I only want to draw just a couple of cylinders. – Sorfosh Feb 26 at 22:38
• So, for example . when $d=32$ and so $m=5$ and $\theta=\frac{\pi}{96}$. Hence The point set is $A=\{(32*cos(k\frac{\pi}{96}),32*sin(k\frac{\pi}{96},0) : k= 1,2..., 192\}$ As I type this, i realize that that is a lot of cylinders (of radius 1/2) so I would hope that this could be somehow automated and that Mathematica can generate the graphs so I do not have to manually do anything. Again, I really appreciate the help. – Sorfosh Feb 27 at 1:37
• @Sorfosh I edited my answer based on your comments. I'm not sure if this looks like what you wanted or not, but it should be a bit closer now. – MassDefect Feb 27 at 2:14
• Thank you! That is immensely helpful. Now the only question that remains is how do I range $d$? I tried Range[32,33] and {32,33} and neither works to draw 2 layers of cylinders for $d=32$ and $d=33$. Since I want a couple of drawings with different amount of layers. – Sorfosh Feb 27 at 20:13
• @Sorfosh I've made a second edit to account for ranging d. Your thought to use either Range or a list {32, 33} is a good one, it's just that the way I wrote the code doesn't work well with that style. – MassDefect Feb 27 at 23:04