Pensieve header: Flying Pogs ... continues pensieve://2015-06/.

<< KnotTheory`

Pog::usage = "Pog[R,r,h,v,m] represents a standard + crossing pog of radius R, height 2h, translation v, rotation matrix m, and tube radius r.";
Pog[R_,r_,h_,v_, m_] := GeometricTransformation[
{
Green, Opacity[0.3], Cylinder[{{0,0,-h},{0,0,h}},R],
Red, Opacity[1], CapForm[None], {
Tube[BSplineCurve[{{1,0,0},{0,0,-h},{-1,0,0}}], r],
Tube[BSplineCurve[{{0,1,0},{0,0,h},{0,-1,0}}], r]
}
},
AffineTransform@{m,v}
]

?Pog

Pog[1,0.1,0.25, {0,0,0}, IdentityMatrix@3] // Graphics3D

PogForm /: PogForm[RR_,R_,r_,h_][pd_PD] := Module[{n,vs,ms,es,i1,d1,i2,d2,tvs,dvs},
tvs={{R,0,0}, {0,R,0}, {-R,0,0},{0,-R,0}};
dvs={{R,0,-h}, {0,R,h}, {-R,0,-h},{0,-R,h}};
n=Length[pd];
es=List@@Union@@pd;
vs=RandomReal[{-RR+R,RR-R}, {n,3}];
ms=Table[Orthogonalize[RandomReal[{-1,1}, {3,3}]], {n}];
Graphics3D[{
Table[Pog[R,r,h,vs[[i]], ms[[i]]], {i,n}],
Blue,Opacity[1], CapForm[None],
Table[
{{i1,d1},{i2,d2}}=Position[pd,e];
Tube[BSplineCurve[{
vs[[i1]]+ms[[i1]].tvs[[d1]], vs[[i1]]+ms[[i1]].(tvs[[d1]]+dvs[[d1]]),
vs[[i2]]+ms[[i2]].(tvs[[d2]]+dvs[[d2]]), vs[[i2]]+ms[[i2]].tvs[[d2]]
}], r],
{e,es}
]
}, Boxed -> False]
]

Knot[8,17] // PD // PogForm[6,1,0.1,0.25]

PD[X[1,4,2,3],X[4,3,1,2]] // PogForm[4,1,0.1,0.25]