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
Rf Ro
Rt
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

CmbM TxtShaftDiae

TxtAlpha

TxtT

TxtY Op4
Op1
Op3

Op2

TxtChX TxtScale

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 <= 0 Then

MsgBox "Please Increase Teeth Qty.", , "Data Review"

FrmGear.Show

TxtZ.SetFocus

Exit Sub

End If

52
2-1-11) Get the gear pressure angle and calculate the other angles to draw

Dim Alpha As Double 'Gear Pressure Angle

Alpha = Val(TxtAlpha.Text)

Dim AlphaRad As Double

AlphaRad = Pi * Alpha / 180

Dim Beta As Double

Beta = 90 / Z

Dim BetaRad As Double

BetaRad = Pi * Beta / 180

Dim Gama As Double

Gama = 90 - (Alpha - Beta)

Dim GamaRad As Double

GamaRad = Pi * Gama / 180

Dim TotalAngle As Double

TotalAngle = 360 / Z

Dim TotalAngleRad As Double

TotalAngleRad = Pi * TotalAngle / 180

53
2-1-12) Control: shaft hole diameter must be smaller than Gear Dedendum

If ChHole.Value = True Then

If SD >= Rd * 2 Then

MsgBox "Please reduce Hole Diameter.", , "Data Review"

FrmGear.Show

TxtShaftDia.SetFocus

Exit Sub

End If

End If

54
2-1-13) Check: Width of Key must be smaller than Shaft hole Diameter

If ChKey.Value = True Then

If KW >= SD Then

MsgBox "Please reduce Width of Key.", , "Data Review"

FrmGear.Show

TxtKeyWidth.SetFocus

Exit Sub

End If

55
2-1-14) Check: Corner point of Key must be Inside of Gear Dedendum

Dim RmaxKey As Double

RmaxKey = Sqr((KW / 2) ^ 2 + (KD + Sqr((SD / 2) ^ 2 - (KW / 2) ^

2)) ^ 2)

If RmaxKey >= Rd Then

'Corner point of Key must be Inside of Gear Dedendum

MsgBox "Please reduce Depth of Key", , "Data Review"

FrmGear.Show

TxtKeyDepth.SetFocus

Exit Sub

End If

End If

56
2-1-15) Check: Chamfer
Chamfer in Y (V) Direction must be smaller than Gear Addendum and in X (H) Direction must be
smaller than (or equal to) Half of Gear thickness

If ChChamfer.Value = True Then

If ChY > 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, 0, Ru)

'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.9

CircleUConst.Construction = True

Dim CircleDConst As Circle2D

Set CircleDConst = F2D.CreateClosedCircle(0, 0, Rd)

'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.10

CircleDConst.Construction = True

Dim CircletConst As Circle2D

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

CircletConst.Construction = True

Dim CircleOConst As Circle2D

Set CircleOConst = F2D.CreateClosedCircle(0, 0, Ro)

'File: Gear1~4.CATPart/Body.2/Sketch.1/Circle.12

CircleOConst.Construction = True

Dim Line1Const As Line2D

Set Line1Const = F2D.CreateLine(0, 0, XPtOc1, YPtOc1)

'File: Gear1~4.CATPart/Body.2/Sketch.1/Line.1

Line1Const.Construction = True

Dim Line2Const As Line2D

Set Line2Const = F2D.CreateLine(0, 0, XPt1, YPt1)

'File: Gear1~4.CATPart/Body.2/Sketch.1/Line.2

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, RefmyCP1)

'File: Gear1~4.CATPart/Body.2/Join.2

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, HSF, RefmyPlaneY, myBody,

myPart, mySF, HS, RefmyJoin, t, Y0)

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, RefmyPlaneY,

myBody, myPart, mySF, HS, RefmyJoin, t, Sc, Y0)

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) 'File:

Gear1.CATPart/Body.2/Pad.1

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 = HSF.AddNewHybridScaling(RefmyRotate1,

RefPtCtr2, (1 + Sc) / 2#)

'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 = F2D.CreateLine(XPt3Ch, YPt3Ch, XPt33Ch,

YPt33Ch)

'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 = F2D.CreateLine(XPt33Ch, YPt32Ch, XPt22Ch,

YPt22Ch)

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

Line3322Ch.StartPoint = Pt33Ch

Line3322Ch.EndPoint = Pt22Ch

Dim Line2211Ch As Line2D

Set Line2211Ch = F2D.CreateLine(XPt22Ch, YPt22Ch, XPt11Ch,

YPt11Ch)

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

Line2211Ch.StartPoint = Pt22Ch

Line2211Ch.EndPoint = Pt11Ch

Dim Line111Ch As Line2D

Set Line111Ch = F2D.CreateLine(XPt11Ch, YPt11Ch, XPt1Ch,

YPt1Ch)

'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-two-
circles-intersect

Types of gears:

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

122