• Author / Uploaded
• feltor21

Citation preview

VB Scripting for CATIA V5: How to Model Gears with VBA User Form

Alireza Reihani Emmett Ross

1

Copyright Information VB Scripting for CATIA V5: How to Model Gears with VBA User Form Version1.1, revised October 2015 Copyright ©2015 by Alireza Reihani and Emmett Ross All rights reserved. No part of this guide may be reproduced or transmitted in any form or by any means, electronic or mechanical, including photocopying, recording, or by any information storage and retrieval system, without permission in writing by the authors. The only exception is by a reviewer, who may quote short excerpts in a review. CATIA is a registered trademark of Dassault Systèmes. No affiliation with, or endorsed by anyone associated, or in any way connected with Dassault Systèmes, Microsoft Corporation, UNIX, or any of their fantastic products. We recognize that some words, model names and designations, for example, mentioned herein are the property of the trademark owner. We use them for identification purposes only. This is not an official publication.

Disclaimer Although the authors have attempted to exhaustively research all sources to ensure the accuracy and completeness of information on the subject matter, the authors assume no responsibility for errors, inaccuracies, omissions, or any other inconsistencies herein. The data contained herein is for informational purposes only and is not represented to be error free. Information may be rendered inaccurate by changes made to the subject of the material, such as the applicable software. No consequential damages can be sought against the authors for the use of these materials by any third parties or for any direct or indirect result of that use. The purpose of this text is to complement and supplement other texts and resources. You are urged to read all the available literature, learn as much as you can and adapt the information to your particular needs. There may be mistakes within this manual. Therefore, the text should only be used as a general and introductory guide and not as the sole source for CATIA macro programming. The information contained herein is intended to be of general interest to you and is provided “as is”, and it does not address the circumstances of any particular individual or entity. Nothing herein constitutes professional advice, nor does it constitute a comprehensive or complete statement of the issues discussed thereto. Readers should also be aware that internet websites listed in this work may have changed or disappeared between when this work was written and when it is read. A prerequisite for this guide is to know the basics of CATIA, programming by Visual Basic, and VBScript for CATIA. To start learning programming for CATIA V5 from scratch, please read VB SCRIPTING FOR CATIA V5 by Emmett Ross.

2

Contents Copyright Information .................................................................................................................... 2 Disclaimer ....................................................................................................................................... 2 Introduction ....................................................................................................................................... 5 Structure of this VB Program ......................................................................................................... 5 Initial Setting ...................................................................................................................................... 7 Step 1: Drawing Gear Types in CATIA ................................................................................................ 8 Step 2: Programming in CATIA step by step .................................................................................... 16 2-1) Getting Data and controlling them (sub: common) ............................................................. 16 2-1-1) Create Form in a new VBA project .................................................................................... 16 2-1-2) Get the Number of Gear Teeth and check its value .......................................................... 44 2-1-3) Get the Module of the Gear and check its value............................................................... 45 2-1-4) Get the thickness of the gear and check its value ............................................................. 46 2-1-5) Get the Diameter of the Shaft Hole and check its value ................................................... 47 2-1-6) Get the width and depth of the Key and check their values ............................................. 48 2-1-7) Get the Chamfer Data and check its value ........................................................................ 49 2-1-8) Get the Helix angle ............................................................................................................ 50 2-1-9) Get the Scale of Diameter and check its value .................................................................. 51 2-1-10) Calculate the five Radiuses necessary to draw Gear Tooth ............................................ 52 2-1-11) Get the gear pressure angle and calculate the other angles to draw ............................. 53 2-1-12) Control: shaft hole diameter must be smaller than Gear Dedendum ............................ 54 2-1-13) Check: Width of Key must be smaller than Shaft hole Diameter .................................... 55 2-1-14) Check: Corner point of Key must be Inside of Gear Dedendum ..................................... 56 2-1-15) Check: Chamfer................................................................................................................ 57 2-1-16) Find the center point of the pitch circle .......................................................................... 58 2-1-17) Find a point on pitch circle .............................................................................................. 59 2-1-18) Calculate the pitch circle radius ...................................................................................... 60 2-1-19) Find the intersection point on Addendum circle by Functions Xn,Yp ............................. 61 2-1-20) Control existence of the Addendum circle ...................................................................... 62 3

2-1-21) Find the center point of the fillet circle ........................................................................... 63 2-1-22) Find the intersection point of pitch circle and fillet circle .............................................. 64 2-1-23) Find the intersection point of the Dedendum circle and fillet circle .............................. 65 2-1-24) Find the last point on Dedendum circle .......................................................................... 66 2-1-25) Control the existence of the Dedendum circle ............................................................... 67 2-2) Create Body (Sub: common) .............................................................................................. 68 2-3) Create Plane for Tooth Profile Sketch .................................................................................. 69 2-4) Create Base Sketch (Tooth Profile Sketch) ........................................................................... 70 2-4-1) Find the Center points of circles and Start point and End point of Arcs ........................... 71 2-5) Create Full Teeth Profile (Circular Pattern) and Join them .................................................. 81 2-6) Type 1: Create Solid (Pad) ..................................................................................................... 85 2-7) Type 2: Create Solid (Multi-section solid) ............................................................................ 86 (Sub: Gear2).................................................................................................................................. 86 2-8) Type 3: Create Solid (Multi-section Solid) ............................................................................ 90 2-9) Type 4: Create Solid (Multi-section Solid) ............................................................................ 95 2-10) Create Hole and Key (Pocket) ........................................................................................... 103 2-11) Create Chamfer (Groove).................................................................................................. 107 2-12) Hiding main planes: .......................................................................................................... 114 2-13) Assign a Toolbar in CATIA ................................................................................................. 115 Thank You! ..................................................................................................................................... 118 Video Demo ................................................................................................................................... 119 Tips and Troubleshooting .............................................................................................................. 120 Appendix I: Keyboard Shortcuts .................................................................................................... 121 Appendix II: Resources................................................................................................................... 122

4

Introduction A good practice to take your CATIA programming skills to the next level is to model a complex example like a gear. In this guide, you’ll learn how to develop a CATVBA program to model different types of gears in CATIA V5. This guide is divided into two main steps: 1. Drawing gears in CATIA V5 using sketcher 2. Programming in CATIA V5 step-by-step including VBA user form In this case, step one is as important as step two, because there are many ways to model a gear but some of them are not good and are inefficient. This is especially evident in Helical Gears where sometimes they create errors in CATIA or the file size and/or time of creation is very high. Before starting these two steps, let’s briefly review the structure of this program.

Structure of this VB Program This program consists of one Module (Module 1) and one Form (FrmGear). Module 1 has two subroutines: CATMain() to show Form and HidePlanes to Hide three main planes (X, Y and Z). Subroutine HidePlanes is not necessary to draw gears, it’s just for better viewing of the gears.

5

Fig 1: Project explorer and Program window in design mode The UserForm consists of seven subroutine and two functions. At first, Subroutine common creates Full Gear Profile, and then, depending on the Gear Type, one of four subroutines that draws the desired gear type: • • • •

Gear 1 Type: Spur Gear 2 Type: Helical Gear 3 Type: Straight Bevel Gear 4 Type: Spiral Bevel

Two functions Xn and Yp are used to calculate coordinates of intersection of two circles (to draw Gear profile). Subroutines HoleKey and Chamfer draw Hole of Shaft and Chamfer.

Fig 2: Subroutines of FrmGear 6

Initial Setting This program creates Hybrid design (Planes, Points,…) in Body and not in Geometrical Set, so it’s necessary that you check Enable hybrid design when you want to create a new Part (Fig 3).

Fig 3: Initial setting: Enable hybrid design You can also change this setting by this method (Fig 4): Tools>Options…>Infrastructure>PartInfrastructure>Part Document (tab)>Hybrid Design: Enable hybrid design inside part bodies and bodies

Fig 4: Setting of Hybrid Design 7

Step 1: Drawing Gear Types in CATIA Before starting a Sketch of the Tooth Profile (manually or by programming), it’s necessary to have equations for drawing a gear tooth profile. • • • • •

Ro = m * Z / 2 where m=module and Z=number of gear teeth Rt = 0.94 * Ro Rd = Ro - 1.25 * m ; Dedendum Ru = Ro + m ; Addendum Rf = 0.35 * m ; (fillet; you can get the value from the user)

Beta

Ru Ro Rt

Rf

Rd Alpha

Gamma

Fig 1-1: Gear profile

8

Note 1: Normally to draw a tooth profile, you must draw circles and lines, then trim them. This can be very difficult to do by programming so use intersection points of two circles by these equations:

𝑥= 𝑦=

𝐿 ∗ (𝑋2 − 𝑋1 ) ℎ ∗ (𝑌2 − 𝑌1 ) ± + 𝑋1 𝑑 𝑑 𝐿 ∗ (𝑌2 − 𝑌1 ) ℎ ∗ (𝑋2 − 𝑋1 ) ∓ + 𝑌1 𝑑 𝑑

𝑑 = �(𝑋1 − 𝑋2 )2 + (𝑌1 − 𝑌2 )2 𝑅12 − 𝑅22 + 𝑑 2 𝐿= 2∗𝑑 ℎ = �𝑅12 − 𝐿2

where x,y are coordinates of intersection points, X1,Y1 are coordinates of center point of first circle with radius=R1 and X2,Y2 are coordinates of center point of second circle with radius=R2. The fillets will also be drawn in sketch rather than using the fillet tool because it will be easier to do programmatically. In this guide, you will draw the Gear Sketch in a plane parallel to XZ plane. As a practice, you can develop this program and then draw a gear in each plane.

9

Fig 1-2: Tooth Profile drawn by finding intersection points

Fig 1-3: First Tooth Profile (Sketch) 10

Note 2: Drawing Full Gear Profile For drawing full teeth profile, it doesn’t appear there is a VB function to have Circular Pattern in Sketch (

). Therefore, we will use Circular pattern in GSD (

).

Fig 1-4: Full Teeth Profile and Create Pad for Gear Type 1 In gear types 2,3 and 4, Multi-section Solid creates the volume. • • • •

Gear 1 Type: Spur = PAD Gear 2 Type: Helical = Multi-section Gear 3 Type: Straight Bevel = Multi-section Gear 4 Type: Spiral Bevel = Multi-section

11

In type 2 (helical gear); after Translating of full teeth profile; it must be rotated (Fig. 1-5).

Fig 1-5: Profile Translated and Rotated

Fig 1-6: Profile Translated and Rotated in normal view

12

Fig 1-7: Gear Type 2 In type 3 (straight bevel); after Translating of full teeth profile; it must be scaled (Fig. 1-8).

Fig 1-8: Profile Translated and Scaled in normal view 13

Fig 1-9: Gear Type 3 (straight bevel) In type 4 (spiral bevel); after Translating of full teeth profile; it must be rotated and be scaled. Do it two times (Fig. 1-10).

Fig 1-10: Profile Translated, Rotated and Scaled in normal view (two times)

14

Fig 1-11: Gear Type 4 (spiral bevel)

We have just created four different types of gear. Now it’s time to add automation so a user can change the size of gears through a user form.

15

Step 2: Programming in CATIA step by step 2-1) Getting Data and controlling them (sub: common)

2-1-1) Create Form in a new VBA project You can get the data needed by using an InputBox but the more user friendly way is to use a TextBox, ComboBox, CheckBox combination in a Form like Fig 2-1-1

Fig 2-1-1: Form to get data for creating the gears to the specified size

16

For creating this User Form, we need to create a new program file. In CATIA, click on the Tools>Macro>Visual Basic Editor... or press Alt+F11 (Fig 2-1-2).

Fig 2-1-2: Enter the Visual Basic Editor

17

If there is not a loaded CATVBA file, one message appears (Fig 2-1-3).

Fig 2-1-3: Launch VBA message Press Yes to create one VBA project. Now Macro libraries window appears (Fig 2-1-4)

18

Fig 2-1-4) Macro libraries window Click on Create new library... button (Library type must be VBA Project Fig 2-1-5). Now Create a new VBA project window appears (Fig. 2-1-5). Enter a path and name for your VBA project. (This path must be valid, otherwise an error message appears and CATIA doesn’t help you to create these Folders.)

19

Fig 2-1-5) Create a new VBA project window By clicking on the Ok button you will come back to Macro libraries window and you will see your new full path of new VBA project in this window (Fig 2-1-6).

20

Fig 2-1-6: new VBA project in Macro libraries window By clicking on Close button you will enter into the VBA environment (Fig 2-1-7)

21

Fig 2-1-7) VBA environment To create a Form, Right click on the Project window (left side in Fig 2-1-7) then click on Insert>UserForm (Fig 2-1-8) or use menu Insert>UserForm (Fig 2-1-9). New Form appears (Fig 2-1-10).

22

Fig 2-1-8: Add a new Form in your VBA project by right click

Fig 2-1-9: Add a new Form in your VBA project by menu 23

Fig 2-1-10: new Form To access to properties of this Form, click on menu View>Properties Window or press F4 or click on Properties window icon (

) or right-click on the form and select properties (Fig 2-

1-11) . Now properties window of Form appears (Fig 2-1-12). Change the Name property of form to FrmGear.

24

Fig 2-1-11: Access to properties of Form by right-click

Fig 2-1-12: properties of Form 25

To access CATIA when the Gear program is running, then set ShowModal property to False (Fig 2-1-13). Forms are displayed by the Show method of the form object. This method has an optional argument to specify whether the form should be displayed as either modal or modeless. A modal form will not let you interact with any other part of the application until that form is closed. This means that you cannot interactively use other CATIA commands or interact with any other forms that might be displayed at the time. Forms are, by default, modal unless otherwise specified. We want to interact with CATIA so set ShowModal property to False.

Fig 2-1-13: ShowModal property of Form Change the Caption property to 3D Gear (Fig 2-1-14). Finally, change the size of the Form (by dragging of corners of Form or by setting width and Height property).

26

Fig 2-1-14: Caption property of Form To classify the controls such as TextBoxes, Labels,... , insert a Frame (Fig 2-1-15) by dragging its icon on Toolbox window (Fig 2-1-16) to Form or by clicking on its icon and click a point on Form. (If you don’t see this window click on menu: View>Toolbox or click on its icon in Standard Toolbars

)

27

Fig 2-1-15: Add a Frame

Fig 2-1-16: Toolbox window

28

Fig 2-1-17: Add Label

Fig 2-1-18: Add TextBox 29

Change the Text Background Color by BackColor property of TextBox (Fig 2-1-19).

Fig 2-1-19: Change Backcolor property of TextBox

30

To show the user that TextBox is a place to enter text, change MousePointer (Fig 2-1-20) and MouseIcon property of TextBox.

Fig 2-1-20: Change MousePointer property of TextBox

31

Change Text Color of TextBox by ForeColor property of TextBox (Fig 2-1-21).

Fig 2-1-21: Change ForeColor property of TextBox

32

Change Font of TextBox and its Height to better viewing of texts by Font property of TextBox (Fig 2-1-22).

Fig 2-1-22: Change Font property of TextBox

33

Change BackStyle property of Label to 0 (Transparency) (Fig 2-1-23) now its color is dependent of Frame color.

Fig 2-1-23: Change BackStyle property of Label

34

To show pictures, put image control and set its Picture property. Pictures should be in format .bmp, .gif or .jpg. (Fig 2-1-24)

Fig 2-1-24: Add Image and set Picture property

35

Each type of gear can have a shaft hole or not. If a shaft hole exists, it can have a key or not. The best control for this purpose is to use a CheckBox (Fig 2-1-25). Put two CheckBoxes and change their Name property to ChHole and ChKey. In MouseUp event of ChHole, write the following code to control the key. Remember: the key can only exist when the shaft hole exists. Private Sub ChHole_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If ChHole.Value = True Then ChKey.Value = False ChKey.Enabled = False Else ChKey.Enabled = True End If End Sub

36

In addition, for gear types 1 and 2, we will add a chamfer option.

Fig 2-1-25: Add CheckBox and set Backstyle property to 0 (Transparent) Private Sub Op1_Click() ChChamfer.Enabled = True End Sub

Private Sub Op2_Click() ChChamfer.Enabled = True End Sub

37

Private Sub Op3_Click() ChChamfer.Value = False ChChamfer.Enabled = False End Sub Private Sub Op4_Click() ChChamfer.Value = False ChChamfer.Enabled = False End Sub

This program can draw four different types of gear but only one at a time can be select. Each time one type is drawn and the user can select only one type so we need four OptionButtons. You can add an image beside each optionButton to visually show the user what each type of gear is.

Fig 2-1-26: Add OptionButton 38

We need a Command button to execute the create gear program. Add a new command button and change the BackColor and ForeColor property (Black and white).

Fig 2-1-27: Add Command Button Continue adding controls and set their properties. After setting properties of a control, you can use Copy-Paste to quickly create the other controls.

39

Fig 2-1-28 shows the Name property of controls that will be used in the VBA program code. ChHole TxtKeyDepth

TxtKeyWidth

ChKeye

TxtZ TxtShaftDiae

CmbM TxtAlpha TxtT TxtY

Op4

Op1

Op3

Op2 TxtScale

TxtChX TxtChY ChChamfer CmdDraw

TxtHelixAngle

Fig 2-1-28: Control Names

40

To show the form of program, add a module to the project. A new module can be added just like adding a form: right-click on the project window and select Insert>Module (Fig 2-1-29).

Fig. 2-1-29 Add a module to VBA project

41

Fig. 2-1-30: New module Now add this code to your newly created module. This code will show the form when the program is run. Sub CATMain() FrmGear.Show End Sub Later on you’ll learn how you can assign this module to an icon in CATIA to show the Form.

42

When the program runs, after clicking on Draw command button, the variable ProfileError is set to false, a subroutines HidePlanes (to be explained later) and common will be executed.

Private Sub CmdDraw_Click() ProfileError = Falsend Call HidePlanes Call Common End Sub

Subroutine common gets the information from the form, analyzes it, creates the body and a plane parallel to XZ plane and finally draws a full gear profile. After assigning the input information to variables, they must be controlled. For example, if the teeth number, module or thickness is zero, the program must alert the user to change it. This is called error handling.

Sub Common() 'Create Base Wireframe of Gear Complete Profile Me.Hide

43

2-1-2) Get the Number of Gear Teeth and check its value

Dim QtyZ As Integer

'Gear Teeth Quantity

QtyZ = Val(TxtZ.Text) Dim Z As Double Z = CDbl(QtyZ) If QtyZ < 2 Then MsgBox "Please increase Gear Teeth.", , "Data Review" FrmGear.Show TxtZ.SetFocus Exit Sub End If

44

2-1-3) Get the Module of the Gear and check its value

Dim m As Double

'Gear Module

m = Val(CmbM.Text) If m = 0 Then MsgBox "Please increase Gear Module", , "Data Review" FrmGear.Show CmbM.SetFocus Exit Sub End If

45

2-1-4) Get the thickness of the gear and check its value

Dim t As Double

'Gear Thickness

t = Val(TxtT.Text) If t = 0 Then MsgBox "Please Enter Gear Thickness.", , "Data Review" FrmGear.Show TxtT.SetFocus Exit Sub End If

46

2-1-5) Get the Diameter of the Shaft Hole and check its value Dim SD As Double

'Gear Shaft Hole Diameter

If ChHole.Value = True Then SD = Val(TxtShaftDia.Text) If SD = 0 Then MsgBox "Please Enter Hole Diameter.", , "Data Review" FrmGear.Show TxtShaftDia.SetFocus Exit Sub End If End If

47

2-1-6) Get the width and depth of the Key and check their values Dim KW As Double

'Gear Key Width

Dim KD As Double

'Gear Key Depth

If ChKey.Value = True Then KW = Val(TxtKeyWidth.Text) If KW = 0 Then MsgBox "Please Enter Width of Key.", , "Data Review" FrmGear.Show TxtKeyWidth.SetFocus Exit Sub End If

KD = Val(TxtKeyDepth.Text) If KD = 0 Then MsgBox "Please Enter Depth of Key.", , "Data Review" FrmGear.Show TxtKeyDepth.SetFocus Exit Sub End If End If

48

2-1-7) Get the Chamfer Data and check its value

Dim ChX As Double 'Gear Chamfer in X (or H in sketcher) direction Dim ChY As Double 'Gear Chamfer in Y (or V in sketcher) direction If ChChamfer.Value = True Then ChX = Val(TxtChX.Text) If ChX = 0 Then MsgBox "Please Enter Chamfer in H Direction.", , "Data Review" FrmGear.Show TxtChX.SetFocus Exit Sub End If

ChY = Val(TxtChY.Text) If ChY = 0 Then MsgBox "Please Enter Chamfer in V Direction.", , "Data Review" FrmGear.Show TxtChY.SetFocus Exit Sub End If End If

49

2-1-8) Get the Helix angle

Dim HelixAngle As Double

'Gear Helix Angle

HelixAngle = Val(TxtHelixAngle.Text)

50

2-1-9) Get the Scale of Diameter and check its value Dim Sc As Double

'Scale in conic Gear types

Sc = Val(TxtScale.Text) If (Op3.Value = True Or Op4.Value = True) And Sc = 0 Then MsgBox "Please Increase Conic Scale.", , "Data Review" FrmGear.Show TxtScale.SetFocus Exit Sub End If

51

2-1-10) Calculate the five Radiuses necessary to draw Gear Tooth

Dim Rt As Double Dim Ro As Double Dim Rd As Double

'Gear minimum Radius (Dedendum)

Dim Ru As Double

'Gear Maximum Radius (Addendum)

Dim Rf As Double

'Fillet Radius

Ro = m * Z / 2# Rt = 0.94 * Ro Rd = Ro - 1.25 * m Ru = Ro + m Rf = 0.35 * m

If Rd Ru Then 'Chamfer in Y (V) Direction must be smaller than Gear Addendum MsgBox "Please reduce chamfer in V direction.", , "Data Review" FrmGear.Show TxtChY.SetFocus Exit Sub End If

If ChX > t / 2 Then 'Chamfer in X (H) Direction must be smaller than (or equal to) Half of Gear thickness MsgBox "Please reduce chamfer in H direction.", , "Data Review" FrmGear.Show TxtChX.SetFocus Exit Sub End If End If

57

2-1-16) Find the center point of the pitch circle

Dim X0 As Double Dim Y0 As Double Dim Z0 As Double X0 = 0 Y0 = Val(TxtY0.Text) Z0 = 0

Dim H0 As Double Dim V0 As Double H0 = 0 V0 = 0

Dim XPtOc1 As Double Dim YPtOc1 As Double XPtOc1 = Rt * Cos(GamaRad) YPtOc1 = Rt * Sin(GamaRad)

58

2-1-17) Find a point on pitch circle

Dim XPt1 As Double Dim YPt1 As Double XPt1 = -Ro * Sin(BetaRad) YPt1 = Ro * Cos(BetaRad)

59

2-1-18) Calculate the pitch circle radius Dim R1 As Double R1 = Sqr((XPtOc1 - XPt1) ^ 2 + (YPtOc1 - YPt1) ^ 2)

60

2-1-19) Find the intersection point on Addendum circle by Functions Xn,Yp

Dim XPt2 As Double Dim YPt2 As Double XPt2 = Xn(H0, V0, Ru, XPtOc1, YPtOc1, R1) YPt2 = Yp(H0, V0, Ru, XPtOc1, YPtOc1, R1)

61

2-1-20) Control existence of the Addendum circle XPt2 must be negative.

If XPt2 >= 0 Then MsgBox "Profile Error, ", , "Data Review" FrmGear.Show Exit Sub End If

62

2-1-21) Find the center point of the fillet circle

Dim XPtOc2 As Double Dim YPtOc2 As Double XPtOc2 = Xn(H0, V0, Rd + Rf, XPtOc1, YPtOc1, R1 + Rf) YPtOc2 = Yp(H0, V0, Rd + Rf, XPtOc1, YPtOc1, R1 + Rf)

63

2-1-22) Find the intersection point of pitch circle and fillet circle

Dim XPt3 As Double Dim YPt3 As Double XPt3 = Xn(XPtOc2, YPtOc2, Rf, XPtOc1, YPtOc1, R1) YPt3 = Yp(XPtOc2, YPtOc2, Rf, XPtOc1, YPtOc1, R1)

64

2-1-23) Find the intersection point of the Dedendum circle and fillet circle

Dim XPt4 As Double Dim YPt4 As Double XPt4 = Xn(XPtOc2, YPtOc2, Rf, H0, V0, Rd) YPt4 = Yp(XPtOc2, YPtOc2, Rf, H0, V0, Rd)

If ProfileError = True Then MsgBox "Profile Error", , "Data Review" FrmGear.Show Exit Sub End If

65

2-1-24) Find the last point on Dedendum circle

Dim TetaRad As Double TetaRad = TotalAngleRad - Atn(Abs(XPt4) / Abs(YPt4)) Dim XPt5 As Double XPt5 = -Rd * Sin(TetaRad) Dim YPt5 As Double YPt5 = Rd * Cos(TetaRad)

66

2-1-25) Control the existence of the Dedendum circle XPt5 must be smaller than XPt4.

If XPt5 >= XPt4 Then MsgBox "Profile Error", , "Data Review" FrmGear.Show Exit Sub End If

67

2-2) Create Body (Sub: common) '---Starting of Base Wireframe--Dim myPart As Part Set myPart = CATIA.ActiveDocument.Part Dim myBodies As Bodies Set myBodies = myPart.Bodies 'Create a new Body Dim myBody As Body Set myBody = myBodies.Add 'File: Gear1~4.CATPart/Body.2

68

2-3) Create Plane for Tooth Profile Sketch Sub: Common 'Define a Shape Factory Dim mySF As ShapeFactory Set mySF = myPart.ShapeFactory

'Define a Hybrid Shape Factory Dim HSF As HybridShapeFactory Set HSF = myPart.HybridShapeFactory

' ---Create Reference Plane (an Offset Plane of ZX Plane) -----Dim myOriginElements As OriginElements, myPlane Set myOriginElements = myPart.OriginElements 'Define ZX Plane Set myPlane = myOriginElements.PlaneZX Dim myPlaneY As HybridShapePlaneOffset Set myPlaneY = HSF.AddNewPlaneOffset(myPlane, Y0, False) 'File: Gear1~4.CATPart/Body.2/Plane.1

myBody.InsertHybridShape myPlaneY 'Create reference for Offset Plane Dim RefmyPlaneY As Reference Set RefmyPlaneY = myPart.CreateReferenceFromObject(myPlaneY) myPart.Update

69

2-4) Create Base Sketch (Tooth Profile Sketch) Sub: common. This sketch (like the sketch of Chamfer and Shaft Hole) is not fully defined. As a practice, you can add constraints to the objects.

70

2-4-1) Find the Center points of circles and Start point and End point of Arcs Use the Intersection points of the circles.

Fig. 2-4-1: Tree of tooth Sketch

71

Dim mySketches As sketches Set mySketches = myBody.sketches

Dim mySketch As Sketch Set mySketch = mySketches.Add(RefmyPlaneY) 'Add Sketch , File: Gear1~4.CATPart/Body.2/Sketch.1

myPart.InWorkObject = mySketch Dim F2D As Factory2D Set F2D = mySketch.OpenEdition()

AlphaRad = Pi * Alpha / 180

Dim PtOc1 As Point2D Set PtOc1 = F2D.CreatePoint(XPtOc1, YPtOc1) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.1

Dim Pt1 As Point2D Set Pt1 = F2D.CreatePoint(XPt1, YPt1) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.2

Dim PtCtr As Point2D Set PtCtr = F2D.CreatePoint(H0, V0) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.3

72

Dim Pt2 As Point2D Set Pt2 = F2D.CreatePoint(XPt2, YPt2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.4

Dim PtOc2 As Point2D Set PtOc2 = F2D.CreatePoint(XPtOc2, YPtOc2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.5

Dim Pt3 As Point2D Set Pt3 = F2D.CreatePoint(XPt3, YPt3) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.6

Dim Pt4 As Point2D Set Pt4 = F2D.CreatePoint(XPt4, YPt4) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.7

Dim Circle1 As Circle2D Set Circle1 = F2D.CreateCircle(XPtOc1, YPtOc1, R1, 0, Pi * 2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.1

Circle1.CenterPoint = PtOc1 Circle1.StartPoint = Pt2 Circle1.EndPoint = Pt3

73

Dim Circle2 As Circle2D Set Circle2 = F2D.CreateCircle(XPtOc2, YPtOc2, Rf, 0, Pi * 2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.2 Circle2.CenterPoint = PtOc2 Circle2.StartPoint = Pt4 Circle2.EndPoint = Pt3 '---Drawing Right side of Profile--Dim Pt2m As Point2D Set Pt2m = F2D.CreatePoint(-XPt2, YPt2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.8

Dim PtOc1m As Point2D Set PtOc1m = F2D.CreatePoint(-XPtOc1, YPtOc1) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.9

Dim Pt3m As Point2D Set Pt3m = F2D.CreatePoint(-XPt3, YPt3) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.10

Dim Circle1m As Circle2D Set Circle1m = F2D.CreateCircle(-XPtOc1, YPtOc1, R1, 0, Pi * 2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.3 Circle1m.CenterPoint = PtOc1m Circle1m.StartPoint = Pt3m Circle1m.EndPoint = Pt2m

74

Dim PtOc2m As Point2D Set PtOc2m = F2D.CreatePoint(-XPtOc2, YPtOc2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.11

Dim Pt4m As Point2D Set Pt4m = F2D.CreatePoint(-XPt4, YPt4) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.12

Dim Circle2m As Circle2D Set Circle2m = F2D.CreateCircle(-XPtOc2, YPtOc2, Rf, 0, Pi * 2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.4 Circle2m.CenterPoint = PtOc2m Circle2m.StartPoint = Pt3m Circle2m.EndPoint = Pt4m

Dim Pt5 As Point2D Set Pt5 = F2D.CreatePoint(XPt5, YPt5) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Point.13 '---------------------------------------------Dim CircleU As Circle2D Set CircleU = F2D.CreateCircle(-0, 0, Ru, 0, Pi * 2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.5 CircleU.CenterPoint = PtCtr CircleU.StartPoint = Pt2m CircleU.EndPoint = Pt2

75

Dim CircleD As Circle2D Set CircleD = F2D.CreateCircle(-0, 0, Rd, 0, Pi * 2) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.6 CircleD.CenterPoint = PtCtr CircleD.StartPoint = Pt4 CircleD.EndPoint = Pt5 '----Drawing Construction Lines and Circles (It is not necessary; just to see Geometric relations) Dim Circle1Const As Circle2D Set Circle1Const = F2D.CreateClosedCircle(XPtOc1, YPtOc1, R1) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.7 Circle1Const.Construction = True Dim Circle2Const As Circle2D Set Circle2Const = F2D.CreateClosedCircle(XPtOc2, YPtOc2, Rf) 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.8 Circle2Const.Construction = True Dim CircleUConst As Circle2D Set CircleUConst = F2D.CreateClosedCircle(0, 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.9

0,

Ru)

0,

Rd)

CircleUConst.Construction = True Dim CircleDConst As Circle2D Set CircleDConst = F2D.CreateClosedCircle(0, 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.10 CircleDConst.Construction = True Dim CircletConst As Circle2D

76

Set CircletConst = F2D.CreateClosedCircle(0, 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.11

0,

Rt)

0,

Ro)

CircletConst.Construction = True Dim CircleOConst As Circle2D Set CircleOConst = F2D.CreateClosedCircle(0, 'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.12 CircleOConst.Construction = True Dim Line1Const As Line2D Set Line1Const = F2D.CreateLine(0, 0, 'File: Gear1~4.CATPart/Body.2/Sketch.1/Line.1

XPtOc1,

YPtOc1)

Line1Const.Construction = True Dim Line2Const As Line2D Set Line2Const = F2D.CreateLine(0, 'File: Gear1~4.CATPart/Body.2/Sketch.1/Line.2

0,

XPt1,

YPt1)

Line2Const.Construction = True '---------------------------------------------

mySketch.CloseEdition myPart.InWorkObject = mySketch myPart.Update

'------------------------------------------------------Dim RefmySketch As Reference Set RefmySketch = myPart.CreateReferenceFromObject(mySketch)

Dim myJoin As HybridShapeAssemble Set myJoin = HSF.AddNewJoin(RefmySketch, RefmySketch) 77

'Join of first Profile Tooth of Gear 'File: Gear1~4.CATPart/Body.2/Join.1

Dim RefmyJoin As Reference Set RefmyJoin = myPart.CreateReferenceFromObject(myJoin)

myBody.InsertHybridShape myJoin myPart.Update

Public Function Xn(x1 As Double, y1 As Double, R1 As Double, x2 As Double, y2 As Double, R2 As Double) As Double Dim D As Double Dim L As Double Dim H As Double Epsilon = 0.00001 D = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2) L = (R1 ^ 2 - R2 ^ 2 + D ^ 2) / (2 * D)

If R1 - L < -Epsilon Then ProfileError = True ‘(R1 must be bigger than L because of Sqr(R1 ^ 2 - L ^ 2); else if R1 is smaller than L, variable ProfileError is set to True and Function will be terminated.) Exit Function End If

78

If Abs(R1 - L) < Epsilon Then H = 0 Else H = Sqr(R1 ^ 2 - L ^ 2) End If Xn = L * (x2 - x1) / D - H * (y2 - y1) / D + x1

End Function

Public Function Yp(x1 As Double, y1 As Double, R1 As Double, x2 As Double, y2 As Double, R2 As Double) As Double Dim D As Double Dim L As Double Dim H As Double Epsilon = 0.00001 D = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2) L = (R1 ^ 2 - R2 ^ 2 + D ^ 2) / (2 * D)

If R1 - L < -Epsilon Then ProfileError = True ‘(R1 must be bigger than L because of Sqr(R1 ^ 2 - L ^ 2) ) Exit Function End If

If Abs(R1 - L) < Epsilon Then 79

H = 0 Else H = Sqr(R1 ^ 2 - L ^ 2) End If Yp = L * (y2 - y1) / D + H * (x2 - x1) / D + y1

End Function

80

2-5) Create Full Teeth Profile (Circular Pattern) and Join them (Sub: common)

'---Create Full Gear Profile in GSD--Dim reference1 As Reference Set reference1 = myPart.CreateReferenceFromName("") Dim reference2 As Reference Set reference2 = myPart.CreateReferenceFromName("") Dim Factory2D1 As Factory2D Set Factory2D1 = mySketch.Factory2D

Dim myCP1 As CircPattern Set myCP1 = mySF.AddNewSurfacicCircPattern(Factory2D1, 1, 2, 20#, 45#, 1, 1, reference1, reference2, True, 0#, True, False) 'File: Gear1~4.CATPart/Body.2/CircPattern.1 myCP1.CircularPatternParameters = catInstancesandAngularSpacing Dim angularRepartition1 As AngularRepartition Set angularRepartition1 = myCP1.AngularRepartition Dim angle1 As Angle Set angle1 = angularRepartition1.AngularSpacing angle1.Value = 360 / Z

Dim angularRepartition2 As AngularRepartition Set angularRepartition2 = myCP1.AngularRepartition

Dim intParam1 As IntParam 81

Set intParam1 = angularRepartition2.InstancesCount intParam1.Value = Z + 1

Dim HS As HybridShapeFactory Set HS = myPart.HybridShapeFactory

HS.GSMVisibility RefmyPlaneY, 0

'Hiding Plane

Dim YDir As HybridShapeDirection

'Define Y direction

Set YDir = HS.AddNewDirectionByCoord(0#, 1#, 0#)

Dim RefYDir As Reference Set RefYDir = myPart.CreateReferenceFromObject(YDir) 'Define Rotation Axis of Circular Pattern

myCP1.SetRotationAxis RefYDir myPart.Update

Dim RefmyCP1 As Reference Set RefmyCP1 = myPart.CreateReferenceFromObject(myCP1) 'joining Full Profile Dim myJoin2 As HybridShapeAssemble Set myJoin2 = HSF.AddNewJoin(RefmyCP1, 'File: Gear1~4.CATPart/Body.2/Join.2

RefmyCP1)

myBody.InsertHybridShape myJoin2 82

myPart.Update

Dim RefmyJoin2 As Reference Set RefmyJoin2 = myPart.CreateReferenceFromObject(myJoin2)

HS.GSMVisibility RefmyJoin, 0 HS.GSMVisibility RefmyJoin2, 0

'---Calling a Subroutine relative to Gear Type---

If Op1.Value = True Then Call Gear1(RefmyJoin2, myPart, mySF, HS, RefmyJoin, t, Y0)

HSF,

RefmyPlaneY,

myBody,

If ChHole.Value = True Then Call HoleKey(mySketches, RefmyPlaneY, myPart, KW, KD, SD, F2D, t, mySF) End If If ChChamfer.Value = True Then Call Chamfer(myOriginElements, mySketches, myPart, ChX, ChY, Ru, Y0, F2D, t, mySF) End If ElseIf Op2.Value = True Then Call Gear2(RefmyJoin2, RefmyCP1, HSF, RefmyPlaneY, myBody, myPart, mySF, HS, RefmyJoin, t, HelixAngle, Y0) If ChHole.Value = True Then Call HoleKey(mySketches, RefmyPlaneY, myPart, KW, KD, SD, F2D, t, mySF)

83

End If If ChChamfer.Value = True Then Call Chamfer(myOriginElements, mySketches, myPart, ChX, ChY, Ru, Y0, F2D, t, mySF) End If ElseIf Op3.Value = True Then Call Gear3(RefmyJoin2, RefmyCP1, HSF, myBody, myPart, mySF, HS, RefmyJoin, t, Sc, Y0)

RefmyPlaneY,

If ChHole.Value = True Then Call HoleKey(mySketches, RefmyPlaneY, myPart, KW, KD, SD, F2D, t, mySF) End If ElseIf Op4.Value = True Then Call Gear4(RefmyJoin2, RefmyCP1, HSF, RefmyPlaneY, myBody, myPart, mySF, HS, RefmyJoin, t, HelixAngle, Sc, Y0) If ChHole.Value = True Then Call HoleKey(mySketches, RefmyPlaneY, myPart, KW, KD, SD, F2D, t, mySF) End If End If

84

2-6) Type 1: Create Solid (Pad) (Sub: Gear1)

Sub Gear1(RefmyJoin2 As Reference, HSF As HybridShapeFactory, RefmyPlaneY As Reference, myBody As Body, myPart As Part, mySF As ShapeFactory, HS As HybridShapeFactory, RefmyJoin As Reference, t As Double, Y0 As Double) 'Create Pad myPart.InWorkObject = myBody Dim myPad As Pad Set myPad = mySF.AddNewPadFromRef(RefmyJoin2, t) Gear1.CATPart/Body.2/Pad.1

'File:

myPart.Update

End Sub

85

2-7) Type 2: Create Solid (Multi-section solid) (Sub: Gear2) 2-7-1) Translate and Rotate of first profile 2-7-2) Create Loft (Multi-section Solid)

Sub Gear2(RefmyJoin2 As Reference, RefmyCP1 As Reference, HSF As HybridShapeFactory, RefmyPlaneY As Reference, myBody As Body, myPart As Part, mySF As ShapeFactory, HS As HybridShapeFactory, RefmyJoin As Reference, t As Double, HelixAngle As Double, Y0 As Double)

'MULTI-SECTION

myPart.InWorkObject = myBody

Set HS = myPart.HybridShapeFactory

Set YDir = HS.AddNewDirectionByCoord(0#, 1#, 0#) Set RefYDir = myPart.CreateReferenceFromObject(YDir) '---Create First Translation of Profile Dim myTranslate1 As HybridShapeTranslate Set myTranslate1 = HS.AddNewEmptyTranslate() 'File: Gear2.CATPart/Body.2/Translate.1

myTranslate1.ElemToTranslate = RefmyCP1 myTranslate1.VectorType = 0

86

myTranslate1.Direction = YDir myTranslate1.DistanceValue = -t myTranslate1.VolumeResult = False

myBody.InsertHybridShape myTranslate1 myPart.InWorkObject = myTranslate1

Dim RefmyTranslate1 As Reference Set RefmyTranslate1 = myPart.CreateReferenceFromObject(myTranslate1)

myPart.Update

'---Rotation of Translated Profile--Dim myRotate1 As HybridShapeRotate Set myRotate1 = HS.AddNewEmptyRotate() 'File: Gear2.CATPart/Body.2/Rotate.1

myRotate1.ElemToRotate = RefmyTranslate1 myRotate1.VolumeResult = False myRotate1.RotationType = 0

myRotate1.Axis = RefYDir myRotate1.AngleValue = HelixAngle myBody.InsertHybridShape myRotate1

87

myPart.InWorkObject = myRotate1 HS.GSMVisibility RefmyTranslate1, 0

Dim RefmyRotate1 As Reference Set RefmyRotate1 = myPart.CreateReferenceFromObject(myRotate1) myPart.Update

Dim myJoin3 As HybridShapeAssemble Set myJoin3 = HSF.AddNewJoin(RefmyRotate1, RefmyRotate1) 'File: Gear1.CATPart/Body.2/Join.3 myBody.InsertHybridShape myJoin3 myPart.Update

Dim RefmyJoin3 As Reference Set RefmyJoin3 = myPart.CreateReferenceFromObject(myJoin3)

myPart.Update '---Create Multi-Section Solid Dim SF As ShapeFactory Set SF = myPart.ShapeFactory

Dim myLoft As Loft Set myLoft = SF.AddNewLoft()

Dim LoftH As HybridShapeLoft Set LoftH = myLoft.HybridShape 88

'File: Gear2.CATPart/Body.2/Multi-sections Solid.1

LoftH.AddSectionToLoft RefmyJoin2, 1, Nothing LoftH.AddSectionToLoft RefmyJoin3, 1, Nothing

Dim RefmyLoft1 As Reference Set RefmyLoft1 = myPart.CreateReferenceFromObject(myLoft)

myPart.Update

HS.GSMVisibility RefmyJoin, 0 HS.GSMVisibility RefmyJoin2, 0 HS.GSMVisibility RefmyJoin3, 0 '''''''''''''' myPart.Update

End Sub

89

2-8) Type 3: Create Solid (Multi-section Solid) (Sub: Gear3) 2-8-1) Translate and Scale of first profile 2-8-1) Create Loft (Multi-section Solid)

Sub Gear3(RefmyJoin2 As Reference, RefmyCP1 As Reference, HSF As HybridShapeFactory,

RefmyPlaneY

As

Reference,

myBody

As

Body,

myPart As Part, mySF As ShapeFactory, HS As HybridShapeFactory, RefmyJoin As Reference, t As Double, Sc As Double, Y0 As Double)

'---MULTI-SECTION myPart.InWorkObject = myBody

Set HS = myPart.HybridShapeFactory

Set YDir = HS.AddNewDirectionByCoord(0#, 1#, 0#)

Set RefYDir = myPart.CreateReferenceFromObject(YDir) '---Create First Translation of Profile Dim myTranslate1 As HybridShapeTranslate Set myTranslate1 = HS.AddNewEmptyTranslate() 'File: Gear3.CATPart/Body.2/Translate.1

90

myTranslate1.ElemToTranslate = RefmyCP1 myTranslate1.VectorType = 0 myTranslate1.Direction = YDir myTranslate1.DistanceValue = -t myTranslate1.VolumeResult = False

myBody.InsertHybridShape myTranslate1 myPart.InWorkObject = myTranslate1

Dim RefmyTranslate1 As Reference Set

RefmyTranslate1

=

myPart.CreateReferenceFromObject(myTranslate1) HS.GSMVisibility RefmyTranslate1, 0 myPart.Update

'---Scale First Translation of Profile Dim PtCtr2 As HybridShapePointCoord Set PtCtr2 = HSF.AddNewPointCoord(0, Y0 - t, 0) 'File: Gear3.CATPart/Body.2/Point.1 myBody.InsertHybridShape PtCtr2 Dim RefPtCtr2 As Reference Set RefPtCtr2 = myPart.CreateReferenceFromObject(PtCtr2) 91

Dim myScaling1 As HybridShapeScaling Set

myScaling1

=

HSF.AddNewHybridScaling(RefmyTranslate1,

RefPtCtr2, Sc) 'File: Gear3.CATPart/Body.2/Scaling.1

myScaling1.VolumeResult = False myBody.InsertHybridShape myScaling1 Dim RefmyScaling1 As Reference Set

RefmyScaling1

=

myPart.CreateReferenceFromObject(myScaling1)

HS.GSMVisibility RefmyScaling1, 0 HS.GSMVisibility RefPtCtr2, 0

Dim myJoin3 As HybridShapeAssemble Set myJoin3 = HSF.AddNewJoin(RefmyScaling1, RefmyScaling1) 'File: Gear3.CATPart/Body.2/Join.3 myBody.InsertHybridShape myJoin3 myPart.Update

92

Dim RefmyJoin3 As Reference Set RefmyJoin3 = myPart.CreateReferenceFromObject(myJoin3)

myPart.Update

'---Create Multi-Section Solid Dim SF As ShapeFactory Set SF = myPart.ShapeFactory

Dim myLoft As Loft Set myLoft = SF.AddNewLoft() 'File: Gear3.CATPart/Body.2/Multi-sections Solid.1

Dim LoftH As HybridShapeLoft Set LoftH = myLoft.HybridShape

LoftH.AddSectionToLoft RefmyJoin2, 1, Nothing LoftH.AddSectionToLoft RefmyJoin3, 1, Nothing

Dim RefmyLoft1 As Reference Set RefmyLoft1 = myPart.CreateReferenceFromObject(myLoft)

93

myPart.Update

HS.GSMVisibility RefmyJoin, 0 HS.GSMVisibility RefmyJoin2, 0 HS.GSMVisibility RefmyJoin3, 0 '-------------------------------

myPart.Update

End Sub

94

2-9) Type 4: Create Solid (Multi-section Solid) (Sub: Gear4) 2-9-1) First Translate, Rotate and Scale of first profile 2-9-2) Second Translate, Rotate and Scale of first profile 2-9-3) Create Loft (Multi-section Solid)

Sub Gear4(RefmyJoin2 As Reference, RefmyCP1 As Reference, HSF As HybridShapeFactory, RefmyPlaneY As Reference, myBody As Body, myPart As Part, mySF As ShapeFactory, HS As HybridShapeFactory, RefmyJoin As Reference, t As Double, HelixAngle As Double, Sc As Double, Y0 As Double)

'---MULTI-SECTION myPart.InWorkObject = myBody

Set HS = myPart.HybridShapeFactory

Set YDir = HS.AddNewDirectionByCoord(0#, 1#, 0#)

Set RefYDir = myPart.CreateReferenceFromObject(YDir) '---Create First Translation of Profile Dim myTranslate1 As HybridShapeTranslate Set myTranslate1 = HS.AddNewEmptyTranslate() 'File: Gear4.CATPart/Body.2/Translate.1

myTranslate1.ElemToTranslate = RefmyCP1 myTranslate1.VectorType = 0 95

myTranslate1.Direction = YDir myTranslate1.DistanceValue = -t / 2 myTranslate1.VolumeResult = False

myBody.InsertHybridShape myTranslate1 myPart.InWorkObject = myTranslate1

Dim RefmyTranslate1 As Reference Set RefmyTranslate1 = myPart.CreateReferenceFromObject(myTranslate1)

myPart.Update

'---Rotate First Translation of Profile Dim myRotate1 As HybridShapeRotate Set myRotate1 = HS.AddNewEmptyRotate() 'File: Gear4.CATPart/Body.2/Rotate.1

myRotate1.ElemToRotate = RefmyTranslate1 myRotate1.VolumeResult = False myRotate1.RotationType = 0

myRotate1.Axis = RefYDir myRotate1.AngleValue = HelixAngle myBody.InsertHybridShape myRotate1

96

myPart.InWorkObject = myRotate1 HS.GSMVisibility RefmyTranslate1, 0

Dim RefmyRotate1 As Reference Set RefmyRotate1 = myPart.CreateReferenceFromObject(myRotate1) myPart.Update HS.GSMVisibility RefmyRotate1, 0 '---Scale First Translation of Profile Dim PtCtr2 As HybridShapePointCoord Set PtCtr2 = HSF.AddNewPointCoord(0, Y0 - t / 2, 0) 'File: Gear4.CATPart/Body.2/Point.1 myBody.InsertHybridShape PtCtr2 Dim RefPtCtr2 As Reference Set RefPtCtr2 = myPart.CreateReferenceFromObject(PtCtr2)

Dim myScaling1 As HybridShapeScaling Set myScaling1 = RefPtCtr2, (1 + Sc) / 2#)

HSF.AddNewHybridScaling(RefmyRotate1,

'File: Gear4.CATPart/Body.2/Scaling.1 myScaling1.VolumeResult = False myBody.InsertHybridShape myScaling1 Dim RefmyScaling1 As Reference Set RefmyScaling1 = myPart.CreateReferenceFromObject(myScaling1)

97

HS.GSMVisibility RefmyScaling1, 0 HS.GSMVisibility RefPtCtr2, 0

Dim myJoin3 As HybridShapeAssemble Set myJoin3 = HSF.AddNewJoin(RefmyScaling1, RefmyScaling1) 'File: Gear4.CATPart/Body.2/Join.3 myBody.InsertHybridShape myJoin3 myPart.Update

Dim RefmyJoin3 As Reference Set RefmyJoin3 = myPart.CreateReferenceFromObject(myJoin3)

myPart.Update '---Create Second Translation of Profile Dim myTranslate2 As HybridShapeTranslate Set myTranslate2 = HS.AddNewEmptyTranslate() 'File: Gear4.CATPart/Body.2/Translate.2

myTranslate2.ElemToTranslate = RefmyCP1 myTranslate2.VectorType = 0 myTranslate2.Direction = YDir myTranslate2.DistanceValue = -t myTranslate2.VolumeResult = False

myBody.InsertHybridShape myTranslate2 myPart.InWorkObject = myTranslate2 98

Dim RefmyTranslate2 As Reference Set RefmyTranslate2 = myPart.CreateReferenceFromObject(myTranslate2)

myPart.Update '---Rotate Second Translation of Profile Dim myRotate2 As HybridShapeRotate Set myRotate2 = HS.AddNewEmptyRotate() 'File: Gear4.CATPart/Body.2/Rotate.2

myRotate2.ElemToRotate = RefmyTranslate2 myRotate2.VolumeResult = False myRotate2.RotationType = 0

myRotate2.Axis = RefYDir myRotate2.AngleValue = 3 * HelixAngle / 2 myBody.InsertHybridShape myRotate2

myPart.InWorkObject = myRotate2 HS.GSMVisibility RefmyTranslate2, 0

Dim RefmyRotate2 As Reference Set RefmyRotate2 = myPart.CreateReferenceFromObject(myRotate2) HS.GSMVisibility RefmyRotate2, 0 99

myPart.Update

'---Scale Second Translation of Profile

Dim PtCtr3 As HybridShapePointCoord 'define center Point of Scale Set PtCtr3 = HSF.AddNewPointCoord(0, Y0 - t, 0) 'File: Gear4.CATPart/Body.2/Point.2 myBody.InsertHybridShape PtCtr3 Dim RefPtCtr3 As Reference Set RefPtCtr3 = myPart.CreateReferenceFromObject(PtCtr3)

Dim myScaling2 As HybridShapeScaling Set myScaling2 = HSF.AddNewHybridScaling(RefmyRotate2, RefPtCtr3, Sc) 'File: Gear4.CATPart/Body.2/Scaling.2 myScaling2.VolumeResult = False myBody.InsertHybridShape myScaling2 Dim RefmyScaling2 As Reference Set RefmyScaling2 = myPart.CreateReferenceFromObject(myScaling2)

HS.GSMVisibility RefmyScaling2, 0 HS.GSMVisibility RefPtCtr3, 0

Dim myJoin4 As HybridShapeAssemble 100

'Joining Scaled Profile Set myJoin4 = HSF.AddNewJoin(RefmyScaling2, RefmyScaling2) 'File: Gear4.CATPart/Body.2/Join.4 myBody.InsertHybridShape myJoin4 myPart.Update

Dim RefmyJoin4 As Reference Set RefmyJoin4 = myPart.CreateReferenceFromObject(myJoin4)

myPart.Update '---Create Multi-Section Solid Dim SF As ShapeFactory Set SF = myPart.ShapeFactory

Dim myLoft As Loft Set myLoft = SF.AddNewLoft() 'File: Gear4.CATPart/Body.2/Multi-sections Solid.1

Dim LoftH As HybridShapeLoft Set LoftH = myLoft.HybridShape

LoftH.AddSectionToLoft RefmyJoin2, 1, Nothing LoftH.AddSectionToLoft RefmyJoin3, 1, Nothing LoftH.AddSectionToLoft RefmyJoin4, 1, Nothing

Dim RefmyLoft1 As Reference 101

Set RefmyLoft1 = myPart.CreateReferenceFromObject(myLoft)

myPart.Update

HS.GSMVisibility RefmyJoin, 0 HS.GSMVisibility RefmyJoin2, 0 HS.GSMVisibility RefmyJoin3, 0 HS.GSMVisibility RefmyJoin4, 0 '------------------------------------------------

myPart.Update

End Sub

102

2-10) Create Hole and Key (Pocket) (Sub: HoleKey) 2-10-1) Create Sketch

Fig 2-10-1: Sketch of Shaft Hole and Key

Sub HoleKey(mySketches As sketches, RefmyPlaneY As Reference, myPart As Part, KW As Double, KD As Double, SD As Double, F2D As Factory2D, t As Double, mySF As ShapeFactory)

Dim mySketchHole As Sketch Set mySketchHole = mySketches.Add(RefmyPlaneY) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2

myPart.InWorkObject = mySketchHole 103

Set F2D = mySketchHole.OpenEdition()

Dim CircleShaft As Circle2D

If ChKey.Value = True Then

Dim XPt1Key As Double Dim YPt1Key As Double XPt1Key = KW / 2 YPt1Key = Sqr((SD / 2) ^ 2 - XPt1Key ^ 2)

Dim XPt2Key As Double Dim YPt2Key As Double XPt2Key = KW / 2 YPt2Key = YPt1Key + KD

Dim XPt3Key As Double Dim YPt3Key As Double XPt3Key = -KW / 2 YPt3Key = YPt2Key

Dim XPt4Key As Double Dim YPt4Key As Double XPt4Key = -KW / 2 YPt4Key = YPt1Key

104

Dim Pt1Key As Point2D Set Pt1Key = F2D.CreatePoint(XPt1Key, YPt1Key) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Point.1 Dim Pt2Key As Point2D Set Pt2Key = F2D.CreatePoint(XPt2Key, YPt2Key) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Point.2 Dim Pt3Key As Point2D Set Pt3Key = F2D.CreatePoint(XPt3Key, YPt3Key) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Point.3 Dim Pt4Key As Point2D Set Pt4Key = F2D.CreatePoint(XPt4Key, YPt4Key) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Point.4

Dim Line12Key As Line2D Set Line12Key = F2D.CreateLine(XPt1Key, YPt1Key, XPt2Key, YPt2Key) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Line.1 Line12Key.StartPoint = Pt1Key Line12Key.EndPoint = Pt2Key

Dim Line23Key As Line2D Set Line23Key = F2D.CreateLine(XPt2Key, YPt2Key, XPt3Key, YPt3Key) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Line.2 Line23Key.StartPoint = Pt2Key Line23Key.EndPoint = Pt3Key 105

Dim Line34Key As Line2D Set Line34Key = F2D.CreateLine(XPt3Key, YPt3Key, XPt4Key, YPt4Key) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Line.3 Line34Key.StartPoint = Pt3Key Line34Key.EndPoint = Pt4Key

Set PtCtr = F2D.CreatePoint(H0, V0) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Point.5

Set CircleShaft = F2D.CreateCircle(0, 0, SD / 2, Pi / 2 + Atn(XPt1Key / YPt1Key), Pi * 2 + Atn(YPt1Key / XPt1Key)) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Circle.1

Else Set CircleShaft = F2D.CreateClosedCircle(0, 0, SD / 2) 'File: Gear1~4.CATPart/Body.2/Pocket.1/Sketch.2/Circle.1 End If mySketchHole.CloseEdition myPart.InWorkObject = mySketchHole myPart.Update

Dim myPocket As Pocket Set myPocket = mySF.AddNewPocket(mySketchHole, t) myPart.Update End Sub 106

2-11) Create Chamfer (Groove) (Sub: Chamfer) 2-11-1) Create Sketch

Fig 2-11-1: Sketch of Chamfer

107

Fig 2-11-2: Tree of Sketch Chamfer

Sub Chamfer(myOriginElements As OriginElements, mySketches As sketches, myPart As Part, ChX As Double, ChY As Double, Ru As Double, Y0 As Double, F2D As Factory2D, t As Double, mySF As ShapeFactory)

Dim myPlaneYZ

Set myPlaneYZ = myOriginElements.PlaneYZ Dim RefmyPlaneYZ As Reference Set RefmyPlaneYZ = myPart.CreateReferenceFromObject(myPlaneYZ)

108

Dim mySketchChamfer As Sketch Set mySketchChamfer = mySketches.Add(RefmyPlaneYZ) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3

myPart.InWorkObject = mySketchChamfer

Set F2D = mySketchChamfer.OpenEdition()

Dim XPt1Ch As Double Dim YPt1Ch As Double XPt1Ch = Y0 - ChX YPt1Ch = Ru

Dim XPt2Ch As Double Dim YPt2Ch As Double XPt2Ch = Y0 + 0 YPt2Ch = Ru - ChY

Dim XPt3Ch As Double Dim YPt3Ch As Double XPt3Ch = Y0 + 0 YPt3Ch = Ru + 2

Dim XPt11Ch As Double Dim YPt11Ch As Double

109

XPt11Ch = XPt1Ch - t + 2 * ChX YPt11Ch = YPt1Ch

Dim XPt22Ch As Double Dim YPt22Ch As Double XPt22Ch = XPt2Ch - t YPt22Ch = YPt2Ch

Dim XPt33Ch As Double Dim YPt33Ch As Double XPt33Ch = XPt3Ch - t YPt33Ch = YPt3Ch

Dim Pt1Ch As Point2D Set Pt1Ch = F2D.CreatePoint(XPt1Ch, YPt1Ch) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Point.1 Dim Pt2Ch As Point2D Set Pt2Ch = F2D.CreatePoint(XPt2Ch, YPt2Ch) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Point.2 Dim Pt3Ch As Point2D Set Pt3Ch = F2D.CreatePoint(XPt3Ch, YPt3Ch) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Point.3

Dim Pt11Ch As Point2D Set Pt11Ch = F2D.CreatePoint(XPt11Ch, YPt11Ch)

110

'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Point.4 Dim Pt22Ch As Point2D Set Pt22Ch = F2D.CreatePoint(XPt22Ch, YPt22Ch) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Point.5 Dim Pt33Ch As Point2D Set Pt33Ch = F2D.CreatePoint(XPt11Ch, YPt33Ch) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Point.6

Dim Line12Ch As Line2D Set Line12Ch = F2D.CreateLine(XPt1Ch, YPt1Ch, XPt2Ch, YPt2Ch) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Line.1 Line12Ch.StartPoint = Pt1Ch Line12Ch.EndPoint = Pt2Ch

Dim Line23Ch As Line2D Set Line23Ch = F2D.CreateLine(XPt2Ch, YPt2Ch, XPt3Ch, YPt3Ch)

'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Line.2 Line23Ch.StartPoint = Pt2Ch Line23Ch.EndPoint = Pt3Ch

Dim Line333Ch As Line2D Set Line333Ch YPt33Ch)

=

F2D.CreateLine(XPt3Ch,

YPt3Ch,

XPt33Ch,

'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Line.3 111

Line333Ch.StartPoint = Pt3Ch Line333Ch.EndPoint = Pt33Ch

Dim Line3322Ch As Line2D Set Line3322Ch YPt22Ch)

=

F2D.CreateLine(XPt33Ch,

YPt32Ch,

XPt22Ch,

'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Line.4 Line3322Ch.StartPoint = Pt33Ch Line3322Ch.EndPoint = Pt22Ch

Dim Line2211Ch As Line2D Set Line2211Ch YPt11Ch)

=

F2D.CreateLine(XPt22Ch,

YPt22Ch,

XPt11Ch,

'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Line.5 Line2211Ch.StartPoint = Pt22Ch Line2211Ch.EndPoint = Pt11Ch

Dim Line111Ch As Line2D Set YPt1Ch)

Line111Ch

=

F2D.CreateLine(XPt11Ch,

YPt11Ch,

XPt1Ch,

'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Line.6 Line111Ch.StartPoint = Pt11Ch Line111Ch.EndPoint = Pt1Ch

112

Dim CenterLine As Line2D Set CenterLine = F2D.CreateLine(0, 0, -t, 0) 'File: Gear1,2.CATPart/Body.2/Groove.1/Sketch.3/Line.7 mySketchChamfer.CenterLine = CenterLine

mySketchChamfer.CloseEdition myPart.InWorkObject = mySketchChamfer myPart.Update

Dim iGroove As Groove Set iGroove = mySF.AddNewGroove(mySketchChamfer)

myPart.Update End Sub

113

2-12) Hiding main planes: (sub HidePlanes) This subroutine just hides Planes XY, YZ and ZX for better viewing of Gears. Sub HidePlanes() Dim myPart As Part Set myPart = CATIA.ActiveDocument.Part Dim OriginElement, myPlaneZX, myPlaneXY, myPlaneYZ Set OriginElement = myPart.OriginElements Set myPlaneXY = OriginElement.PlaneXY Set myPlaneYZ = OriginElement.PlaneYZ Set myPlaneZX = OriginElement.PlaneZX

Dim RefmyPlaneXY As Reference Set RefmyPlaneXY = myPart.CreateReferenceFromObject(myPlaneXY) Dim RefmyPlaneYZ As Reference Set RefmyPlaneYZ = myPart.CreateReferenceFromObject(myPlaneYZ) Dim RefmyPlaneZX As Reference Set RefmyPlaneZX = myPart.CreateReferenceFromObject(myPlaneZX)

Set HS = myPart.HybridShapeFactory HS.GSMVisibility RefmyPlaneXY, 0 HS.GSMVisibility RefmyPlaneYZ, 0 HS.GSMVisibility RefmyPlaneZX, 0 myPart.Update End Sub

114

2-13) Assign a Toolbar in CATIA

As a last step, you can add an icon to a toolbar to quickly execute your program. Follow these pictures to add an icon assigned to your VB program.

115

Now you can Drag &Drop your Module in a Toolbar.

116

117

Thank You! Now you know how to model and program gears in CATIA V5! You're on your way to automating even more repetitive processes and impressing your co-workers and bosses. For more real world examples, articles, tutorials, and how-to videos please visit www.scripting4v5.com I hope you’ve enjoyed this program as much as we loved writing it for you. We really appreciate each and every one of you for taking time out of your day or evening to read this, and if you have an extra second, we would love to hear what you think about it. Please leave a comment or forum post at http://www.scripting4v5.com, or if you’d rather reach us in private, don’t hesitate to shoot us an email. We’ve worked very hard on this guide and spent countless hours working on the website and simply ask that you do not share this document with anyone who has not purchased it. Please refer all friends and colleagues to the website, www.scripting4v5.com. To all of my subscribers, followers and friends out there, old and new, thank you for the gift of your support. I only hope this guide can begin to repay you for the time and attention that you’ve given me. Here’s to you and your continued success! Thanks again, good luck, and happy programming! - Alireza Reihani and Emmett Ross

118

Video Demo Watch this program in action. https://www.youtube.com/watch?v=Q7pERp0PfvI

119

Tips and Troubleshooting If your code is not working, please double check these sections of code:

Confused or still stuck? Post your question in the forum if you get stuck or have any suggestions for improving the tutorial. http://www.scripting4v5.com/forums/forum/catia-macro-programming/ 120

Appendix I: Keyboard Shortcuts Default CATIA and VBA editor shortcuts: CATIA V5:  F1: Open the CATIA V5 online contextual help file  Alt+F8: Macro shortcut  Alt+F11: Open the macro editor VBA Editor:  F1: Visual Basic help  F2: Open the Object Browser  F4: Properties Window  F5: Run macro  F7: Code window  F8: Step Into  Crtl + Break: Break  Crtl + J: List properties and methods  Alt+F11: Go back to CATIA  End: Quit a running macro

121

Appendix II: Resources The following is a list of resources used when creating this tutorial and other recommended tools.

HOW TO: Création Roue Dentée Paramétrée CATIA V5 R20 By madriver30 https://www.youtube.com/watch?v=dvyLuOPvMV8

Helical gear part by Priyam Bajpai https://www.youtube.com/watch?v=H989ooFHrxo

Reference for finding intersection points of two circles: http://math.stackexchange.com/questions/256100/how-can-i-find-the-points-at-which-twocircles-intersect

Types of gears: http://sdp-si.com/resources/gears/pdf/gear_types_manufacturing.pdf

122