I recorded this macro to draw an eye-bolt in X4. One problem that came about is the blend effect. It is essentially broken somehow. Try this out and select the threaded section which has the effect and add more steps. It should be evenly spaced threads...not the case. What's wrong in the code?
Private Sub CommandButton12_Click()
Dim s1 As Shape
Dim OrigSelection As ShapeRange
Set s1 = ActiveLayer.CreateEllipse2(2.900091, 9.000268, 0.522327, -0.522327)
s1.Fill.ApplyNoFill
s1.Outline.SetProperties 0.006, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=45#
Dim s2 As Shape
Set s2 = ActiveLayer.CreateRectangle(2.771205, 8.667878, 3.028976, 7.535039)
s2.Fill.ApplyNoFill
s2.Outline.SetProperties 0.006, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=45#
Dim s3 As Shape
Set s3 = ActiveLayer.CreateEllipse2(2.900091, 9.000268, 0.33239, -0.33239)
s3.Fill.ApplyNoFill
s3.Outline.SetProperties 0.006, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=45#
Dim s4 As Shape
Set s4 = s2.Weld(s1, True, True)
s1.Delete
s2.Delete
s4.Curve.Nodes.Range(4, 5).Fillet 0.050831, True
Dim s5 As Shape
Set s5 = ActiveLayer.CreateLineSegment(3.028976, 7.577925, 2.80039, 7.539894)
s5.Fill.ApplyNoFill
s5.Outline.SetProperties 0.006, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100), ArrowHeads(0), ArrowHeads(0), cdrFalse, cdrFalse, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, MiterLimit:=45#
Dim s6 As Shape
Set s6 = s5.Duplicate
s6.Move 0#, 0.772866
s6.OrderToFront
Dim eff1 As Effect
Set eff1 = s5.CreateBlend(s6, 20, cdrDirectFountainFillBlend, cdrBlendSteps, 0.2, 0#, False, Nothing, False, 0, 0, False)
eff1.Blend.LinkAcceleration = True
Dim eff2 As Effect
Set eff2 = s5.CreateBlend(s6, 20, cdrDirectFountainFillBlend, cdrBlendSteps, 0.2, 0#, False, Nothing, False, 0, 0, False)
eff2.Blend.LinkAcceleration = True
Set s1 = ActiveDocument.CreateShapeRangeFromArray(ActiveLayer.Shapes(6), ActiveLayer.Shapes(5), ActiveLayer.Shapes(4), ActiveLayer.Shapes(1).Effects.BlendEffects(1).Blend.BlendGroup, ActiveLayer.Shapes(1).Effects.BlendEffects(2).Blend.BlendGroup, ActiveLayer.Shapes(1)).Group
ActiveDocument.ReferencePoint = cdrCenter
s1.SetPosition 1, 1
End Sub