Generating cylindrical geometry via extruding a section

Question

Toady I want to build geometry as shown below:

I know the Mathematica owns the built-in like Cylinder[], Sphere[] and so on, but it lacks of a function that could construct user-defined geometry, so I have a trial as below:

TengentLine

 lineCofficient[x1_, y1_, r1_, x2_, y2_, r2_, style_] := Block[
 {},
   First@Solve[
   {(k x1 - y1 + b)/Sqrt[1 + k^2] == r1  style, 
    (k x2 - y2 + b)/Sqrt[1 + k^2] == r2 style},
   {k, b}]
 ]

tangentPoint

 tangentPoint[x1_, y1_, r1_, x2_, y2_, r2_, style_] := Block[
  {k, b},
 {
   Solve[
    {y == k x + b /.lineCofficient[x1, y1, r1, x2, y2, r2,style],
    (x - x1)^2 + (y - y1)^2 == r1^2}, {x, y}],
   Solve
    [{y == k x + b /. lineCofficient[x1, y1, r1, x2, y2,r2,style],
    (x - x2)^2 + (y - y2)^2 == r2^2}, {x, y}]
 } // Flatten[#, 1] &
]

My geometry

  FinalGeometry[x1_, y1_, z1_, r1_, x2_, y2_, z2_, r2_, h_] := Block[
  {x, y, one, two, three, four},
  Graphics3D[
  {Cylinder[{{x1, y1, z1}, {x1, y1, h}}, r1],
   Cylinder[{{x2, y2, z2}, {x2, y2, h}}, r2],

  one = Flatten[
    List[
      Join[{x, y} /.tangentPoint[x1, y1, r1, x2, y2, r2, -1], {{z1}, {z1}}, 2],
     Join[{x, y} /.tangentPoint[x1, y1, r1, x2, y2, r2, -1], {{h}, {h}}, 2]], 1];         

  two = Flatten[
     List[
     Join[{x, y} /.tangentPoint[x1, y1, r1, x2, y2, r2, 1], {{z1}, {z1}}, 2], 
     Join[{x, y} /. tangentPoint[x1, y1, r1, x2, y2, r2, 1], {{h}, {h}}, 2]], 1];

  three = Flatten[
    List[
     Join[{x, y} /.tangentPoint[x1, y1, r1, x2, y2, r2, -1], {{z1}, {z1}}, 2],
     Join[{x, y} /.tangentPoint[x1, y1, r1, x2, y2, r2, 1], {{z1}, {z1}}, 2]], 1];

  four = Flatten[
    List[
      Join[{x, y} /.tangentPoint[x1, y1, r1, x2, y2, r2, -1], {{h}, {h}}, 2], 
      Join[{x, y} /.tangentPoint[x1, y1, r1, x2, y2, r2, 1], {{h}, {h}}, 2]], 1];

  Sequence @@
    (Polygon /@ 
      Flatten[{Partition[one, 3, 1], Partition[two, 3, 1], 
       Partition[three, 3, 1], Partition[four, 3, 1]}, 1])
  },
    BoxRatios -> Automatic
  ]
 ]

Using my function:

 FinalGeometry[0, 0, 0, 3, 12, 0, 0, 2, 2]

However, I felt my method is tedious and ingeneral. In addition, there are many other geometry "by extruding a section" like 3D software Autodesk Inventor.

So my question is:

• Is there a good and easy method to realize my function FinalGeometry[]?

• Is there possible to construct a function that can generate a geometry that can rotate freely (not a static image) by extruding a section?

Answer 1

This is an extended version of the brief suggestion that I gave in my comment above.

Solve for the tangent points.

Solve[{#.# &[{x1, y1} - {0, 0}] == 3^2, #.# &[{x2, y2} - {12, 0}] == 2^2, 
  (y2 - y1)/(x2 - x1) == -((x1 - 0)/(y1 - 0)) == -((x2 - 12)/(y2 - 0))}, 
  {x1, y1, x2, y2}]

(* This gives 4 solutions *)

Define the extrusion vector.

extrude = {0, 0, 2};

CAVEAT: The various pattern tests that I use are somewhat incomplete.

Define a rule for embedding a 2D coordinate in the z == 0 plane.

rule2Dto3D = {x_?NumericQ, y_?NumericQ} :> {x, y, 0};

Define a rule for converting a circle to an extruded cylinder.

ruleCircle2Cylinder = Circle[p_?VectorQ, r_?NumericQ] :> Cylinder[{p, p + extrude}, r];

Define a rule for converting a list of line segments (assumed closed) to a box with caps on its bottom and top.

ruleClosedLine2Box = Line[p : {(_?VectorQ) ..}] :> 
  {Polygon[{#[[1]], #[[2]], #[[2]] + extrude, #[[1]] + extrude}] & /@ Partition[p, 2, 1], 
  Polygon[p], Polygon[(# + extrude) & /@ p]};

Define the 2D object — this uses one of the tangent points solutions (see above).

object2D = {Circle[{0, 0}, 3], Circle[{12, 0}, 2],
  Line[{{x1, y1}, {x2, y2}, {x2, -y2}, {x1, -y1}, {x1, y1}}] /.
  {x1 -> 1/4, y1 -> -(Sqrt[143]/4), x2 -> 73/6, y2 -> -(Sqrt[143]/6)}};

Extrude the 2D object to create a 3D object.

object3D = object2D /. rule2Dto3D /. {ruleClosedLine2Box, ruleCircle2Cylinder};

Display the 2D and 3D objects.

{Graphics@object2D, Graphics3D@object3D}