home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F41419_modGear.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-16  |  12.5 KB  |  446 lines
  1. Attribute VB_Name = "modGear"
  2. '******************************************************************'
  3. '*                                                                *'
  4. '*                      TurboCAD for Windows                      *'
  5. '*                   Copyright (c) 1993 - 2001                    *'
  6. '*             International Microcomputer Software, Inc.         *'
  7. '*                            (IMSI)                              *'
  8. '*                      All rights reserved.                      *'
  9. '*                                                                *'
  10. '******************************************************************'
  11.  
  12.  
  13. ' This sample creates 3D-drawing of gear
  14. Public Sub CreateGear()
  15.  
  16. Dim App As Application
  17. Dim ActDr As Drawing
  18. Dim Grs As Graphics
  19. Dim grfThis As Graphic
  20. Dim Vers As Vertices
  21. Dim Ver As Vertex
  22. Dim grChild As Graphic
  23.     Set App = IMSIGX.Application
  24.     Set ActDr = App.ActiveDrawing
  25. Dim Space%
  26.     Space = ActDr.Properties("TileMode")
  27.     If Space <> 1 Then
  28.         MsgBox ("This macros works only in Modal Space")
  29.         Exit Sub
  30.     End If
  31.     Set Grs = ActDr.Graphics
  32.     Set grfThis = Grs.Add(7)
  33. Dim Pi#
  34.     Pi = 3.14159265
  35. Dim X0#, Y0#, Z0#
  36.     X0 = 5#
  37.     Y0 = 5#
  38.     Z0 = 0#
  39.     frmGear.Show
  40.  
  41. Dim TeethNum# 'Count of Teeth
  42.         TeethNum = CDbl(frmGear.TextBox1.Text)
  43.         
  44. Dim D0#, D1# 'External diameter
  45.         D0 = CDbl(frmGear.TextBox2.Text)
  46.         D1 = CDbl(frmGear.TextBox3.Text)
  47. Dim n As Long
  48.     n = TeethNum
  49. Dim Rext#, Rint#, r1#, r2#, r3#
  50. Dim fi#, dfi#, alp#, bet#, gam#
  51. Dim xc#, yc#, zc#
  52. Dim h#, H0#, H2#, H3#, H4#, H1#
  53.         H0 = CDbl(frmGear.TextBox6.Text)
  54. Dim i As Long, j As Long
  55.     Rext = D0 / 2
  56. Dim m#
  57.     m = D0 / (n + 2)
  58.     h = 2.25 * m
  59.     Rint = Rext - h
  60.     r1 = D1 / 2
  61.     xc = X0
  62.     yc = Y0
  63.     zc = Z0 - H0
  64.     dfi = 2 * Pi / n
  65.     alp = Pi / 3 / n
  66.     bet = Pi / 3 / n
  67.     gam = Pi / 3 / n
  68. Dim xi#, yi#, zi#
  69.     zi = zc
  70.     j = 0
  71.     Set grChild = grfThis.Graphics.Add(11)
  72. Set Vers = grChild.Vertices
  73.     For i = 0 To n - 1
  74.         fi = i * dfi
  75.         If i = 0 Then
  76.             xi = xc + Rint * Cos(fi - (alp + bet))
  77.             yi = yc + Rint * Sin(fi - (alp + bet))
  78.             Set Ver = Vers.Add(xi, yi, zi, True)
  79.         End If
  80.         j = j + 1
  81.         xi = xc + Rext * Cos(fi - alp)
  82.         yi = yc + Rext * Sin(fi - alp)
  83.         Set Ver = Vers.Add(xi, yi, zi, True)
  84.         xi = xc + Rext * Cos(fi + alp)
  85.         yi = yc + Rext * Sin(fi + alp)
  86.         Set Ver = Vers.Add(xi, yi, zi, True)
  87.         xi = xc + Rint * Cos(fi + (alp + bet))
  88.         yi = yc + Rint * Sin(fi + (alp + bet))
  89.         Set Ver = Vers.Add(xi, yi, zi, True)
  90.         xi = xc + Rint * Cos(fi + (alp + bet + 2 * gam))
  91.         yi = yc + Rint * Sin(fi + (alp + bet + 2 * gam))
  92.         Set Ver = Vers.Add(xi, yi, zi, True)
  93.     Next i
  94. Dim xCon#, yCon#, zCon#
  95.     xCon = xi
  96.     yCon = yi
  97.     zCon = zi
  98.     
  99.     dfi = 2 * Pi / 30
  100.     For i = 0 To 30
  101.         fi = -i * dfi
  102.         xi = xc + r1 * Cos(fi)
  103.         yi = yc + r1 * Sin(fi)
  104.         zi = zc
  105.         If i = 0 Then
  106.             Set Ver = Vers.Add(xi, yi, zi, False)
  107.         Else
  108.             Set Ver = Vers.Add(xi, yi, zi, True)
  109.         End If
  110.     Next i
  111.     Set Ver = Vers.Add(xCon, yCon, zCon, False)
  112.     
  113.     grChild.Closed = True
  114.     grChild.Properties("PenColor") = QBColor(8)
  115.     grChild.Properties("Thickness") = 2 * H0
  116.     grChild.Properties("Solid") = 0
  117.     
  118.     
  119. ' ----------------------------------------------------------------------
  120. Dim D2#
  121.         D2 = CDbl(frmGear.TextBox4.Text)
  122.         H1 = CDbl(frmGear.TextBox7.Text)
  123.     r1 = D1 / 2
  124.     r2 = D2 / 2
  125.     xc = X0
  126.     yc = Y0
  127.     zc = Z0 - H1
  128.     zi = zc
  129.     dfi = 2 * Pi / 30
  130.     Set grChild = grfThis.Graphics.Add(11)
  131.     Set Vers = grChild.Vertices
  132.  
  133.     For i = 0 To 30
  134.         fi = i * dfi
  135.         xi = xc + r1 * Cos(fi)
  136.         yi = yc + r1 * Sin(fi)
  137.         zi = zc
  138.         If i = 0 Then
  139.             Set Ver = Vers.Add(xi, yi, zi, False)
  140.         Else
  141.             Set Ver = Vers.Add(xi, yi, zi, True)
  142.         End If
  143.     Next i
  144.     xCon = xi
  145.     yCon = yi
  146.     zCon = zi
  147.     
  148.     For i = 0 To 30
  149.         fi = -i * dfi
  150.         xi = xc + r2 * Cos(fi)
  151.         yi = yc + r2 * Sin(fi)
  152.         zi = zc
  153.         If i = 0 Then
  154.             Set Ver = Vers.Add(xi, yi, zi, False)
  155.         Else
  156.             Set Ver = Vers.Add(xi, yi, zi, True)
  157.         End If
  158.     Next i
  159.     Set Ver = Vers.Add(xCon, yCon, zCon, False)
  160.     grChild.Closed = True
  161.     grChild.Properties("PenColor") = QBColor(8)
  162.     grChild.Properties("Thickness") = 2 * H1
  163.     grChild.Properties("Solid") = 0
  164.                
  165. ' ----------------------------------------------------------------------
  166. Dim Di#, ri#
  167.         Di = CDbl(frmGear.TextBox5.Text)
  168.         H2 = CDbl(frmGear.TextBox8.Text)
  169.     r2 = D2 / 2
  170.     ri = Di / 2
  171.     xc = X0
  172.     yc = Y0
  173.     zc = Z0 - H2
  174.     zi = zc
  175.     dfi = 2 * Pi / 30
  176.     Set grChild = grfThis.Graphics.Add(11)
  177. Set Vers = grChild.Vertices
  178.     For i = 0 To 30
  179.         fi = i * dfi
  180.         xi = xc + r2 * Cos(fi)
  181.         yi = yc + r2 * Sin(fi)
  182.         zi = zc
  183.         If i = 0 Then
  184.             Set Ver = Vers.Add(xi, yi, zi, False)
  185.         Else
  186.             Set Ver = Vers.Add(xi, yi, zi, True)
  187.         End If
  188.     Next i
  189.     xCon = xi
  190.     yCon = yi
  191.     zCon = zi
  192.     
  193.     For i = 0 To 30
  194.         fi = -i * dfi
  195.         xi = xc + ri * Cos(fi)
  196.         yi = yc + ri * Sin(fi)
  197.         zi = zc
  198.         If i = 0 Then
  199.             Set Ver = Vers.Add(xi, yi, zi, False)
  200.         Else
  201.             Set Ver = Vers.Add(xi, yi, zi, True)
  202.         End If
  203.     Next i
  204.     Set Ver = Vers.Add(xCon, yCon, zCon, False)
  205.     grChild.Closed = True
  206.     grChild.Properties("PenColor") = QBColor(8)
  207.     grChild.Properties("Thickness") = 2 * H2
  208.     grChild.Properties("Solid") = 0
  209. ' ----------------------------------------------------------------------
  210.     H3 = CDbl(frmGear.TextBox9.Text)
  211.     xc = X0
  212.     yc = Y0
  213.     H4 = H1 * 3
  214.     zc = Z0 - H3
  215.     zi = zc
  216.     dfi = 2 * Pi / 30
  217.     Set grChild = grfThis.Graphics.Add(11)
  218. Set Vers = grChild.Vertices
  219.     For i = 0 To 30
  220.         fi = i * dfi
  221.         xi = xc + ri * Cos(fi)
  222.         yi = yc + ri * Sin(fi)
  223.         zi = zc
  224.         If i = 0 Then
  225.             Set Ver = Vers.Add(xi, yi, zi, False)
  226.         Else
  227.             Set Ver = Vers.Add(xi, yi, zi, True)
  228.         End If
  229.     Next i
  230.     grChild.Closed = True
  231.     grChild.Properties("PenColor") = QBColor(8)
  232.     grChild.Properties("Thickness") = 2 * H3
  233.     grChild.Properties("Solid") = 0
  234.  
  235. ' End gear
  236. ' --------------------------------------------------------------------------
  237. ' --------------------------------------------------------------------------
  238. ' --------------------------------------------------------------------------
  239. ' Begin Bearings  -  1
  240.     H4 = CDbl(frmGear.TextBox10.Text)
  241.  Dim rb1#, rb2#, rb3#, rb4#
  242.  Dim hb#
  243.  Dim rr#
  244.  Dim zb#
  245.     rr = 0.2 * ri
  246.     hb = 2 * rr
  247.     zb = H4
  248.     
  249. '  First ring
  250.     rb1 = ri
  251.     rb2 = rb1 + hb / 4
  252.     xc = X0
  253.     yc = Y0
  254.     zi = zb
  255.     dfi = 2 * Pi / 30
  256.     Set grChild = grfThis.Graphics.Add(11)
  257. Set Vers = grChild.Vertices
  258.     For i = 0 To 30
  259.         fi = i * dfi
  260.         xi = xc + rb2 * Cos(fi)
  261.         yi = yc + rb2 * Sin(fi)
  262.         If i = 0 Then
  263.             Set Ver = Vers.Add(xi, yi, zi, False)
  264.         Else
  265.             Set Ver = Vers.Add(xi, yi, zi, True)
  266.         End If
  267.     Next i
  268.     xCon = xi
  269.     yCon = yi
  270.     zCon = zi
  271.     
  272.     For i = 0 To 30
  273.         fi = -i * dfi
  274.         xi = xc + rb1 * Cos(fi)
  275.         yi = yc + rb1 * Sin(fi)
  276.         If i = 0 Then
  277.             Set Ver = Vers.Add(xi, yi, zi, False)
  278.         Else
  279.             Set Ver = Vers.Add(xi, yi, zi, True)
  280.         End If
  281.     Next i
  282.     Set Ver = Vers.Add(xCon, yCon, zCon, False)
  283.     grChild.Closed = True
  284.     grChild.Properties("PenColor") = RGB(0, 0, 255)
  285.     grChild.Properties("Thickness") = hb
  286.     grChild.Properties("Solid") = 0
  287. ' --------------------------------------------------------------------
  288.  
  289. '  Second ring
  290.     rb3 = rb2 + 2 * rr
  291.     rb4 = rb3 + hb / 4
  292.     xc = X0
  293.     yc = Y0
  294.     zi = zb
  295.     dfi = 2 * Pi / 30
  296.     Set grChild = grfThis.Graphics.Add(11)
  297. Set Vers = grChild.Vertices
  298.    For i = 0 To 30
  299.         fi = i * dfi
  300.         xi = xc + rb4 * Cos(fi)
  301.         yi = yc + rb4 * Sin(fi)
  302.         If i = 0 Then
  303.             Set Ver = Vers.Add(xi, yi, zi, False)
  304.         Else
  305.             Set Ver = Vers.Add(xi, yi, zi, True)
  306.         End If
  307.     Next i
  308.     xCon = xi
  309.     yCon = yi
  310.     zCon = zi
  311.     
  312.     For i = 0 To 30
  313.         fi = -i * dfi
  314.         xi = xc + rb3 * Cos(fi)
  315.         yi = yc + rb3 * Sin(fi)
  316.         If i = 0 Then
  317.             Set Ver = Vers.Add(xi, yi, zi, False)
  318.         Else
  319.             Set Ver = Vers.Add(xi, yi, zi, True)
  320.         End If
  321.     Next i
  322.     Set Ver = Vers.Add(xCon, yCon, zCon, False)
  323.     grChild.Closed = True
  324.     grChild.Properties("PenColor") = RGB(0, 0, 255)
  325.     grChild.Properties("Thickness") = hb
  326.     grChild.Properties("Solid") = 0
  327. ' --------------------------------------------------------------------
  328. ' Draw Bolls as spheres
  329.     zi = zb + hb / 2
  330.     dfi = 2 * Pi / 16
  331.     For i = 0 To 16
  332.         fi = i * dfi
  333.         xi = xc + (rb2 + rr) * Cos(fi)
  334.         yi = yc + (rb2 + rr) * Sin(fi)
  335.     Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
  336. Set Vers = grChild.Vertices
  337.         Set Ver = grChild.Vertices.Add(xi, yi, zi, False)
  338.         Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False)
  339.         grChild.Properties("PenColor") = QBColor(4)
  340.         grChild.Properties("Solid") = 0
  341.     Next i
  342.  
  343. ' --------------------------------------------------------------------------
  344. ' --------------------------------------------------------------------------
  345. ' --------------------------------------------------------------------------
  346. ' Begin Bearings  -  2
  347.     rr = 0.2 * ri
  348.     hb = 2 * rr
  349.     zb = -H4 - hb
  350.     
  351. '  First ring
  352.     rb1 = ri
  353.     rb2 = rb1 + hb / 4
  354.     xc = X0
  355.     yc = Y0
  356.     zi = zb
  357.     dfi = 2 * Pi / 30
  358.     Set grChild = grfThis.Graphics.Add(11)
  359. Set Vers = grChild.Vertices
  360.     For i = 0 To 30
  361.         fi = i * dfi
  362.         xi = xc + rb2 * Cos(fi)
  363.         yi = yc + rb2 * Sin(fi)
  364.         If i = 0 Then
  365.             Set Ver = Vers.Add(xi, yi, zi, False)
  366.         Else
  367.             Set Ver = Vers.Add(xi, yi, zi, True)
  368.         End If
  369.     Next i
  370.     xCon = xi
  371.     yCon = yi
  372.     zCon = zi
  373.     
  374.     For i = 0 To 30
  375.         fi = -i * dfi
  376.         xi = xc + rb1 * Cos(fi)
  377.         yi = yc + rb1 * Sin(fi)
  378.         If i = 0 Then
  379.             Set Ver = Vers.Add(xi, yi, zi, False)
  380.         Else
  381.             Set Ver = Vers.Add(xi, yi, zi, True)
  382.         End If
  383.     Next i
  384.     Set Ver = Vers.Add(xCon, yCon, zCon, False)
  385.     grChild.Closed = True
  386.     grChild.Properties("PenColor") = RGB(0, 0, 255)
  387.     grChild.Properties("Thickness") = hb
  388.     grChild.Properties("Solid") = 0
  389. ' --------------------------------------------------------------------
  390.  
  391. '  Second ring
  392.     rb3 = rb2 + 2 * rr
  393.     rb4 = rb3 + hb / 4
  394.     xc = X0
  395.     yc = Y0
  396.     zi = zb
  397.     dfi = 2 * Pi / 30
  398.     Set grChild = grfThis.Graphics.Add(11)
  399. Set Vers = grChild.Vertices
  400.     For i = 0 To 30
  401.         fi = i * dfi
  402.         xi = xc + rb4 * Cos(fi)
  403.         yi = yc + rb4 * Sin(fi)
  404.         If i = 0 Then
  405.             Set Ver = Vers.Add(xi, yi, zi, False)
  406.         Else
  407.             Set Ver = Vers.Add(xi, yi, zi, True)
  408.         End If
  409.     Next i
  410.     xCon = xi
  411.     yCon = yi
  412.     zCon = zi
  413.     
  414.     For i = 0 To 30
  415.         fi = -i * dfi
  416.         xi = xc + rb3 * Cos(fi)
  417.         yi = yc + rb3 * Sin(fi)
  418.         If i = 0 Then
  419.             Set Ver = Vers.Add(xi, yi, zi, False)
  420.         Else
  421.             Set Ver = Vers.Add(xi, yi, zi, True)
  422.         End If
  423.     Next i
  424.     Set Ver = Vers.Add(xCon, yCon, zCon, False)
  425.     grChild.Closed = True
  426.     grChild.Properties("PenColor") = RGB(0, 0, 255)
  427.     grChild.Properties("Thickness") = hb
  428.     grChild.Properties("Solid") = 0
  429. ' --------------------------------------------------------------------
  430. ' Draw Bolls as spheres
  431.     zi = zb + hb / 2
  432.     dfi = 2 * Pi / 16
  433.     For i = 0 To 16
  434.         fi = i * dfi
  435.         xi = xc + (rb2 + rr) * Cos(fi)
  436.         yi = yc + (rb2 + rr) * Sin(fi)
  437.         Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
  438.         Set Vers = grChild.Vertices
  439.         Set Ver = grChild.Vertices.Add(xi, yi, zi, False)
  440.         Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False)
  441.         grChild.Properties("PenColor") = QBColor(4)
  442.         grChild.Properties("Solid") = 0
  443.    Next i
  444. End Sub
  445.  
  446.