5
$\begingroup$

Toady I want to build geometry as shown below:

enter image description here

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]

enter image description here

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?

Improve this question
$\endgroup$
10
  • $\begingroup$ Related: How to extrude a 3D image from a binary 2D image. $\endgroup$ Commented Jul 21, 2014 at 12:53
  • $\begingroup$ @Mr.Wizard,I think it isn't duplicte,because (6206) is just a image,not a geomatry that can rotate. $\endgroup$ Commented Jul 21, 2014 at 12:58
  • $\begingroup$ @Mr.Wizard,I would like to use a geomatry that can rotate freely to construct a robot model,Can you help me? $\endgroup$ Commented Jul 21, 2014 at 13:03
  • 1
    $\begingroup$ @Mr.Wizard,In Jens's method,ColorReplace and Raster3D is not in V8,in addition,halirutan's solution takes many time to calculate and it is hard to rotate. $\endgroup$ Commented Jul 21, 2014 at 14:39
  • 2
    $\begingroup$ Does this do the sort of thing you are looking for? - extrude = {0, 0, 1}; rule2Dto3D = {x_?AtomQ, y_?AtomQ} :> {x, y, 0}; ruleLine2Polygon = Line[{p_?VectorQ, q_?VectorQ}] :> Polygon[{p, q, q + extrude, p + extrude}]; ruleCircle2Cylinder = Circle[p_?VectorQ, r_?AtomQ] :> Cylinder[{p, p + extrude}, r]; object2D = {Line[{{0, 0}, {8, 0}}], Circle[{0, 0}, 2], Circle[{8, 0}, 1]}; object3D = object2D /. rule2Dto3D /. {ruleLine2Polygon, ruleCircle2Cylinder}; {Graphics@object2D, Graphics3D@object3D}. It is limited to extruding line segments and circles, but extra 2D to 3D rules could be added. $\endgroup$ Commented Jul 21, 2014 at 14:53

1 Answer 1

Reset to default
6
$\begingroup$

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}

enter image description here

Improve this answer
$\endgroup$
0

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.