TC Thread Macro

TC Thread Macro first created 18/09/05 Page Author: Ty Harness

Here's a macro to produce a 3D screw thread in TurboCAD (tested in v10.51pro). My Intention is make a function that can produce a reasonable accurate screw thread. Figure 1 shows a UNC 1/2 inch 13 threads per inch thread. UNC has a 30 degree flank angle. There are many screw threads around the world and my intention is make a database from which the TurboCAD user can select any thread.

Figure 1 - Example UNC thread 1/2 inch 13 threads per inch

This is the macro at its simplest stage - just a triangle and a 3D revolve about an axis. Start a new drawing with imperial units.

Tools
VBA macros
macros

type anything over Project 1 (say) screwthread
new
editor
Insert Module

and then copy and paste everything between '*** ~~~~ '*****
into the VBA editor

File
save screwthread
anywhere (say) TC macros folder

file close and return to TC

You should see a dialog
Press Screw

Zoom Extents isometric view

'*****************************************************************************

Private Const PI = 3.1415927
Private Const degtorad = 0.0174532


Sub screw()
'default 1/2 inch UNC 13 threads per inch

Dim strP As String
strP = InputBox("Pitch", "Screw Thread", 0.076923, 100, 100)

Dim strD As String

strD = InputBox("Blank Diameter", "Screw Thread", 0.5, 100, 100)

Dim strFA As String
strFA = InputBox("Flank Angle DEG", "Screw Thread", 30, 100, 100)

draw_screw True, 1#, CDbl(strP), CDbl(strD), CDbl(strFA)



End Sub









Private Function draw_screw(RightHanded As Boolean, Length As Double, Pitch As Double, OD As Double, flankAngle As Double) As Long


Dim rotang As Double


Dim P As Double     'pitch

Dim theta As Double 'flank angle
Dim S2 As Double    'Depth of truncation of triangular height at root

Dim S1 As Double    'Depth of truncation of triangular height at crest
Dim r2 As Double    'Root radius

Dim r1 As Double    'crest radius
Dim E As Double     'Effective Diameter

Dim n As Double     'Number of starts


Dim D As Double     'Major Diameter

Dim dmin As Double  'Minor Diameter
Dim h As Double     'height of thread

'D = E + 0.5 * P * cot(theta) - 2 * S1
'dmin = E - 0.5 * P * cot(theta) + 2 * S2
'h = 0.5 * P * cot(theta) - (S1 + S2)


  D = OD
  theta = flankAngle
  P = Pitch
  h = P / (2 * Tan(theta * degtorad))
  dmin = D - 2 * h

rotang = (Length / P) * 360

Dim App As Application
    Dim ActDr As Drawing
    Dim Grs As Graphics
    Dim gr As Graphic
    Dim Gr1 As Graphic
    Dim Ver As Vertex



    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
    
    Set gr = Grs.Add(, "TCW40SPIN")  '

    gr.Properties("$ROTATIONANGLE") = rotang 'deg
    gr.Properties("$STEP") = P + P * 0.0001 'pitch
    If RightHanded = True Then gr.Properties("$HANDINESS") = 0 Else gr.Properties("$HANDINESS") = 1
    gr.Properties("$COILNUMBER") = rotang / 360 'number of coils

   
   'screw axis
   Set Ver = gr.Vertices.Add(0, 0, 0)
   Set Ver = Nothing
   Set Ver = gr.Vertices.Add(100, 0, 0)
   Set Ver = Nothing

    
    
    Set Gr1 = Grs.Add(, "polyline")
    Set Ver = Gr1.Vertices.Add(0, dmin * 0.5, 0)
    Set Ver = Nothing
    
    Set Ver = Gr1.Vertices.Add(P * 0.5, D * 0.5, 0)
    Set Ver = Nothing

    
    Set Ver = Gr1.Vertices.Add(P, dmin * 0.5, 0)
    Set Ver = Nothing
    
    Set Ver = Gr1.Vertices.AddClose
    Set Ver = Nothing

   
   
    Set Gr1 = Grs.Remove(Gr1.Index)
    gr.Graphics.AddGraphic Gr1
   
   gr.RotateAxis PI / 2, 0, -1000, 0, 0, 1000, 0
  'gr.MoveRelative 0, 0, -3
  
   draw_screw = gr.ID

  Set Gr1 = Nothing
  Set gr = Nothing

  Set Grs = Nothing
  Set ActDr = Nothing
  Set App = Nothing

End Function
'****************************************************************************]

[Home] [Mechanics] [Welding] [Software] [CAD] [Math]

Tested in Firefox 1.06: FireFox homepage