4
$\begingroup$

Dmccooey is a site that contains 3D virtual models and coordinates of a large variety of polyhedra.

An example of a coordinates file you can retrieve from the site is:

Propello Tetrahedron (canonical) C0 = 0.139680581996106531822799916239 C1 = 0.509755332493385520099017792717 C2 = 0.606267870861478462919986663126 C0 = (cbrt(4 * (11 + 3 * sqrt(69))) - cbrt(4 * (3 * sqrt(69) - 11)) - 1) / 3 C1 = (cbrt(4 * (25 + 3 * sqrt(69))) + cbrt(4 * (25 - 3 * sqrt(69))) - 5) / 3 C2 = (cbrt(4 * (371 + 33*sqrt(69))) + cbrt(4 * (371 - 33*sqrt(69))) - 1) / 33 V0 = ( C1, C0, 1.0) V1 = ( C1, -C0, -1.0) V2 = ( -C1, -C0, 1.0) V3 = ( -C1, C0, -1.0) V4 = ( 1.0, C1, C0) V5 = ( 1.0, -C1, -C0) V6 = (-1.0, -C1, C0) V7 = (-1.0, C1, -C0) V8 = ( C0, 1.0, C1) V9 = ( C0, -1.0, -C1) V10 = ( -C0, -1.0, C1) V11 = ( -C0, 1.0, -C1) V12 = ( C2, -C2, C2) V13 = ( C2, C2, -C2) V14 = ( -C2, C2, C2) V15 = ( -C2, -C2, -C2) Faces: { 12, 0, 2, 10 } { 12, 10, 9, 5 } { 12, 5, 4, 0 } { 13, 1, 3, 11 } { 13, 11, 8, 4 } { 13, 4, 5, 1 } { 14, 2, 0, 8 } { 14, 8, 11, 7 } { 14, 7, 6, 2 } { 15, 3, 1, 9 } { 15, 9, 10, 6 } { 15, 6, 7, 3 } { 0, 4, 8 } { 1, 5, 9 } { 2, 6, 10 } { 3, 7, 11 }

Each time that I want to open such a polyhedron in mathematica, I copy the information and manually adjust it to fit the language for mathematica.

For example, I rewrote the information above to the code shown below:

C0 = 0.139680581996106531822799916239; C1 = 0.509755332493385520099017792717; C2 = 0.606267870861478462919986663126; V0 = { C1, C0, 1.0}; V1 = { C1, -C0, -1.0}; V2 = { -C1, -C0, 1.0}; V3 = { -C1, C0, -1.0}; V4 = { 1.0, C1, C0}; V5 = { 1.0, -C1, -C0}; V6 = {-1.0, -C1, C0}; V7 = {-1.0, C1, -C0}; V8 = { C0, 1.0, C1}; V9 = { C0, -1.0, -C1}; V10 = { -C0, -1.0, C1}; V11 = { -C0, 1.0, -C1}; V12 = { C2, -C2, C2}; V13 = { C2, C2, -C2}; V14 = { -C2, C2, C2}; V15 = { -C2, -C2, -C2}; vTSIc = {}; For[i = 0, i <= 79, i++; AppendTo[vTSIc, ToExpression[StringJoin[{"V", ToString[i-1]}]]] ] fTSIc = {{13, 1, 3, 11}, {13, 11, 10, 6}, {13, 6, 5, 1}, {14, 2, 4, 12}, {14, 12, 9, 5}, {14, 5, 6, 2}, {15, 3, 1, 9 }, {15, 9, 12, 8}, {15, 8, 7, 3}, {16, 4, 2, 10}, {16, 10, 11, 7}, {16, 7, 8, 4}, {1, 5, 9}, {2, 6, 10}, {3, 7, 11}, {4, 8, 12}}; Show[Graphics3D[{EdgeForm[{Thick}], Polygon /@ Map[vTSIc[[#1]] & , fTSIc, {2}]}], PlotRange-> All,Boxed -> False]

canonical propello tetrahedron

I am sure there must be a more efficient way than manually changing all curved brackets () seen for the vertices V0-V15 to the curly ones {}, adding semi-colons ; to the end of the lines and copy-pasting the faces in a new list.

I am wondering if anyone has done this before or if there are ways to automate it.

Thank you in advance.

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ Are you aware of the polyhedra already built-in in Mathematica? Have a look at PolyhedronData[] $\endgroup$ Commented May 5, 2023 at 14:23
  • $\begingroup$ Oh no I wasn't aware. Thank you! I didn't know there were so many built in in Mathematica. I cannot find the propellor solids in the list, is that correct? $\endgroup$ Commented May 5, 2023 at 17:18

2 Answers 2

Reset to default
4
$\begingroup$ 
getDMMCCOOEYpolyhedron = Import["http://dmccooey.com/polyhedra/" <> # <> ".txt", "Lines"] &; split = If[Length[#] == 4, Drop[#, {2}], #] & @ Map[DeleteCases["Faces:" | ""]] @ Split[Drop[#, 2], ! StringStartsQ["Faces" | "V0" | "C0"] @ #2 &] &; processStrings = Map @ StringReplace[{"cbrt" -> "CubeRoot", "sqrt" -> "Sqrt", "(" ~~ a__ ~~ ")" /; StringContainsQ[a, ","] :> "{" <> a <> "}", "=" ~~ a : Shortest[__] ~~ "=" ~~ __ :> "=" <> a}]; coordsAndFaceIndices = If[Length @ # == 2, {0, 1} + #, {#2, 1 + #3} & @@ #] & @ ToExpression[#, TraditionalForm] &; fromDMCCCOOEY = coordsAndFaceIndices @* processStrings @* split @* getDMMCCOOEYpolyhedron;

Examples:

{coords, faceIndices} = fromDMCCCOOEY @ "PropelloTetrahedron"; Graphics3D[GraphicsComplex[coords, Polygon @ faceIndices], Boxed -> False]

enter image description here

Graphics3D[GraphicsComplex[#, Polygon@#2], Boxed -> False] & @@ fromDMCCCOOEY["GreatDisdyakisDodecahedron"]

enter image description here

Graphics3D[GraphicsComplex[#, Polygon@#2], Boxed -> False] & @@ fromDMCCCOOEY["IcositruncatedDodecadodecahedron"]

enter image description here

Improve this answer
$\endgroup$
3
  • $\begingroup$ When I try this approach with "Cube" I get an error saying " Function::slotn: Slot number 3 in {#2,1+#3}& cannot be filled from ({#2,1+#3}&)[{{0.5,0.5,0.5},{0.5,0.5,-0.5},{0.5,-0.5,0.5},{0.5,-0.5,-0.5},{-0.5,0.5,0.5},{-0.5,0.5,-0.5},{-0.5,-0.5,0.5},{-0.5,-0.5,-0.5}},{{0,1,5,4},{0,4,6,2},{0,2,3,1},{7,3,2,6},{7,6,4,5},{7,5,1,3}}]." And it doesn't print $\endgroup$ Commented May 8, 2023 at 15:18
  • 1
    $\begingroup$ @PTeeuwen, please use the updated coordsAndFaceIndices . $\endgroup$ Commented May 8, 2023 at 16:34
  • $\begingroup$ Awesome! Thank you $\endgroup$ Commented May 8, 2023 at 19:58
6
$\begingroup$

If you do not want to use built-in function PolyhedronData[] as proposed by @Sjoerd C. de Vries and want to train your Mathematica programming, you can automate the whole process of parsing the file. Below is an example – not the optimal or the most pedagogical one – of how you can do it by combining several functions for string and expression manipulation.

parseDmccooeyFile[fileName_] := Module[{replaceParentheses, parse, initString, facesString, rules, vertices, faces}, replaceParentheses[s_String] := If[StringCount[s, ","] == 2, StringReplace[s, {"(" -> "{", ")" -> "}"}], s]; parse[s_String] := ToExpression[s, TraditionalForm, Hold] /. sqrt -> Sqrt /. cbrt -> CubeRoot /. Set -> Rule // Rationalize // ReleaseHold; {initString, facesString} = StringSplit[fileString, "Faces:"]; rules = parse@*replaceParentheses /@ Drop[StringSplit[initString, ("\r" | "\n") ..], 1]; vertices = Last /@ Select[rules, StringTake[SymbolName[First[#]], 1] == "V" &] /. Reverse[rules]; faces = Part[vertices, # + 1] & /@ (ToExpression /@ StringSplit[facesString, ("\r" | "\n") ..]); {vertices, faces} ]; {vertices, faces} = parseDmccooeyFile["data.txt"]
Improve this answer
$\endgroup$
3
  • $\begingroup$ Awesome! Thank you. I am a bit stuck though still as I don't know yet how to import data.txt to the mathematica workspace and to then use it? I know about << Import["/Users/...../data.txt"] >>, but I don't know yet how to use it as input to the function you have written. $\endgroup$ Commented May 5, 2023 at 17:46
  • $\begingroup$ You just use parseDmccooeyFile["/Users/.../data.txt"]. $\endgroup$ Commented May 5, 2023 at 17:51
  • $\begingroup$ Oh that does make sense. Thanks! $\endgroup$ Commented May 5, 2023 at 18:21

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.