CATIA齿轮

利用CA TIA宏编写的VB程序，选择不同参数，在CA TIA中生成相应参数齿轮。

工作界面
Option Base 1
Dim r As Double '齿轮分度圆半径
Dim rf As Double '齿根圆半径
Dim rb As Double '基圆半径
Dim ra As Double '齿顶圆半径
Dim xt As Double '设置临时坐标变量
Dim yt As Double
Dim index As Double '循环变量
Dim pitchT As Double
Dim dataT() As Double '齿轮模数数据
Dim dataT2() As Double
Const PI = 3.14159265358979
Private Sub SpinButton1_Change()
Form1.TextBox1.Text = CStr(Form1.SpinButton1.V alue)
End Sub
Private Sub Form_Initialize()
bel1.Caption = "齿数z"
bel2.Caption = "模数m"
Form1.TextBox1.Text = "25"
bel3.Caption = "齿厚B"
Form1.TextBox2.Text = "20"
bel4.Caption = "压力角α"
Form1.TextBox3.Text = "20"
Form1.TextBox3.Enabled = False
Form1.Frame1.Caption = "渐开线圆柱齿轮选项(&O)"
bel5.Caption = "螺旋升角β"
Form1.TextBox4.Text = "0"
mand1.Caption = "创建"
mand2.Caption = "取消"
Form1.SpinButton1.V alue = Form1.TextBox1.Text
bel6.Caption = "齿轮旋向"
boBox2.AddItem "直齿"
boBox2.AddItem "左旋"
boBox2.AddItem "右旋"
boBox2.ListIndex = 0
Form1.TextBox4.Enabled = IIf(boBox2.Text = "直齿", False, True)
ReDim dataT(22) '定义齿轮模数数据
dataT(1) = 4
dataT(2) = 4.5
dataT(3) = 5
dataT(4) = 5.5
For index = 6 To 10
dataT(index - 1) = index
Next index
For index = 10 To 14
dataT(index) = dataT(index - 1) + 2
Next index
dataT(15) = 22
dataT(16) = 25
dataT(17) = 28
dataT(18) = 32
dataT(19) = 36
dataT(20) = 40
dataT(21) = 45
dataT(22) = 50
ReDim dataT2(22)
dataT2(1) = 0.1
dataT2(2) = 0.12
dataT2(3) = 0.15
dataT2(4) = 0.2
dataT2(5) = 0.25
dataT2(6) = 0.3
dataT2(7) = 0.35
dataT2(8) = 0.4
For index = 9 To 14
dataT2(index) = dataT2(index - 1) + 0.1
Next index
For index = 15 To 22
dataT2(index) = dataT2(index - 1) + 0.25 Next index
For index = LBound(dataT2) To UBound(dataT2)
boBox1.AddItem dataT2(index) Next index
For index = LBound(dataT) To UBound(dataT)
boBox1.AddItem dataT(index) Next index
boBox1.ListIndex = 21 '设置初始显示位置End Sub
'purpose:
'Inputs: mT:
' zT:
' aT:
' bT:
' B:
' LOrR:
Private Sub ComboBox2_Click()
Dim p As String
Form1.TextBox4.Enabled = IIf(boBox2.Text = "直齿", False, True)
Form1.TextBox4.Text = IIf(Form1.TextBox4.Enabled, Form1.TextBox4.Text, "0")
If V al(boBox2.ListIndex) = 0 Then
p = App.Path & "\直齿轮.jpg"
Picture1.Picture = LoadPicture(p)
End If
If V al(boBox2.ListIndex) = 1 Then
p = App.Path & "\左旋齿轮.jpg"
Picture1.Picture = LoadPicture(p)
End If
If V al(boBox2.ListIndex) = 2 Then
p = App.Path & "\右旋齿轮.jpg"
Picture1.Picture = LoadPicture(p)
End If
End Sub
Private Sub Command1_Click()
If V al(Form1.TextBox1.Text) < 14 Then MsgBox "为避免根切，齿轮最小齿数应大于等于14。

请重新输入齿数数据。

", vbExclamation + vbOKOnly: Exit Sub
CreateGeneralGear V al(boBox1.Text), V al(Form1.TextBox1.Text), V al(Form1.TextBox3.Text), V al(Form1.TextBox4.Text), V al(Form1.TextBox2.Text), V al(boBox2.ListIndex)
End
End Sub
Private Sub Command2_Click()
End
End Sub
Public Function EvaluateX(ByV al rbT As Double, ByV al t As Double) As Double '注意这里的参数方程的取值范围为0~1
EvaluateX = rbT * Sin(t * PI / 2) - rbT * t * PI / 2 * Cos(t * PI / 2)
End Function
Public Function EvaluateY(ByV al rbT As Double, ByV al t As Double) As Double '这里的参数t
取值也为0~1
EvaluateY = rbT * Cos(t * PI / 2) + rbT * PI * t / 2 * Sin(t * PI / 2)
End Function
Sub CreateGeneralGear(ByV al mT As Double, ByV al zT As Double, ByV al aT As Double, ByV al bT As Double, ByV al B As Double, ByV al LOrR As Integer)
'个参数意义分别为模数m,齿数z,压力角alpha,螺旋升角beta,齿厚B（角度单位均为deg）,直齿,左旋或右旋0,1,2
aT = aT / 180 * PI '转换角度单位deg到rad
r = zT * mT / 2 '计算齿轮各参数的值
rb = r * Cos(aT)
rf = r - 1.25 * mT
ra = r + 1 * mT
If Not (Abs(bT) < 0.0001 Or LOrR = 0) Then pitchT = 2 * PI * ra * Tan((90 - bT) * PI / 180)
On Error Resume Next
Set CA TIA = GetObject(, "CA TIA.Application")
If Err.Number <> 0 Then
Set CA TIA = CreateObject("CA TIA.Application")
CA TIA.Visible = True
End If
On Error GoTo 0
Set documents1 = CA TIA.Documents
Set partDocument1 = documents1.Add("Part")
Set part1 = partDocument1.Part
Set originElements1 = part1.OriginElements
Dim hybridBodies1 As Object
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As Object
Set hybridBody1 = hybridBodies1.Add()
= "渐开线齿轮图形数据"
Dim hybridShapeFactory1 As Object
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridShapePointCoord1 As Object
Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
= "原点"
hybridBody1.AppendHybridShape hybridShapePointCoord1 '添加所添加的原点
part1.Update
Dim reference1 As Object
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1) '新建一个参考点（圆心）
Dim hybridShapePlaneExplicit1 As Object
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Dim reference2 As Object
Set reference2 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1) '新建一个参考平面，定义在originElements类中决定
Dim hybridShapeCircleCtrRad1 As Object
Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, r) '据中心点和参考面,半径画分度圆
= "分度圆"
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1 '在当前模型中显示已在数据层面添加的模型
Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, rb) '画基圆
= "基圆"
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1
Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, rf) '画齿根圆
= "齿根圆"
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1
Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, ra) '画齿顶圆
= "齿顶圆"
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Dim hybridShapePointOnPlane1 As Object '通过循环的方法画由15个点组成的渐开线For index = 0 To 14
Set hybridShapePointOnPlane1 = hybridShapeFactory1.AddNewPointOnPlane(reference1, EvaluateX(rb, index * 0.03), EvaluateY(rb, index * 0.03)) '用曲面库类(hybridshapefactory)的方法在所选参考平面上新建各渐开线点
= "Point_" & CStr(index + 1)
hybridBody1.AppendHybridShape hybridShapePointOnPlane1
Next index
part1.Update '更新当前零部件几何体
Dim hybridShapeSpline1 As Object
Set hybridShapeSpline1 = hybridShapeFactory1.AddNewSpline()
hybridShapeSpline1.SetClosing 0 '设置样条曲线封闭样式为0（0为不封闭）
hybridShapeSpline1.SetSplineType 0 '设置样条曲线投影样式0为不投影，否则应额外设置相应的reference平面变量
Dim hybridShapes1 As Object
Set hybridShapes1 = hybridBody1.HybridShapes
For index = 2 To 16
Set hybridShapePointOnPlane1 = hybridShapes1.Item("Point_" & CStr(index - 1))
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointOnPlane1)
hybridShapeSpline1.AddPointWithConstraintExplicit reference1, Nothing, -1#, 1, Nothing, 0# '顺序添加参考约束点以绘制样条曲线spline
Next index
= "渐开线曲线"
hybridBody1.AppendHybridShape hybridShapeSpline1 '向现有模型中添加已经生成的样条曲线
part1.InWorkObject = hybridShapeSpline1
part1.Update
Set hybridShapeCircleCtrRad1 = hybridShapes1.Item("分度圆") '本段代码完成渐开线与分度圆相交点的绘制
Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1) '建立相交命令的第一个参数
Set reference2 = part1.CreateReferenceFromObject(hybridShapeSpline1)
Dim hybridShapeIntersection1 As Object
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2)
= "分度圆交点"
hybridBody1.AppendHybridShape hybridShapeIntersection1 '添加所生成的相交线
part1.InWorkObject = hybridShapeIntersection1
part1.Update
'本段代码完成由原点到分度圆与渐开线交点的直线绘制
Set hybridShapePointCoord1 = hybridShapes1.Item("原点")
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Set reference2 = part1.CreateReferenceFromObject(hybridShapeIntersection1)
Dim hybridShapeLinePtPt1 As Object
Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2) = "定位直线1"
hybridBody1.AppendHybridShape hybridShapeLinePtPt1
part1.InWorkObject = hybridShapeLinePtPt1
part1.Update
'本段代码完成由定位直线1和定角弧所做出的定位直线2及其二者的角平分线
Set hybridShapePointCoord1 = hybridShapes1.Item("原点") '画定位圆弧1
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Set hybridShapeIntersection1 = hybridShapes1.Item("分度圆交点")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeIntersection1)
Dim reference3 As Object
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference3 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Dim hybridShapeCircleCtrPt1 As Object
Set hybridShapeCircleCtrPt1 = hybridShapeFactory1.AddNewCircleCtrPtWithAngles(reference1, reference2, reference3, False, 0#, 360 / zT / 2)
= "圆弧1"
hybridBody1.AppendHybridShape hybridShapeCircleCtrPt1
part1.Update
Set hybridShapePointCoord1 = hybridShapes1.Item("原点") '画定位直线2
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Set reference2 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMCircle.5;2);None:(Li mits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSup port;MFBRepV ersion_CXR15)", hybridShapeCircleCtrPt1)
Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2) = "定位直线2"
hybridBody1.AppendHybridShape hybridShapeLinePtPt1
part1.Update
Set hybridShapeLinePtPt1 = hybridShapes1.Item("定位直线1")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
Dim hybridShapeLinePtPt2 As Object
Set hybridShapeLinePtPt2 = hybridShapes1.Item("定位直线2")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeLinePtPt2)
Dim hybridShapeLineBisecting1 As Object
Set hybridShapeLineBisecting1 = hybridShapeFactory1.AddNewLineBisecting(reference1,
reference2, 0#, ra + 10, False, 1)
= "定位直线3"
hybridBody1.AppendHybridShape hybridShapeLineBisecting1
part1.InWorkObject = hybridShapeLineBisecting1
part1.Update
'以下代码完成由定位角平分线所作对称特征即在其基础之上的圆弧的绘制
Set hybridShapeSpline1 = hybridShapes1.Item("渐开线曲线")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1) '建立对称特征的第1个参数
Set hybridShapeLineBisecting1 = hybridShapes1.Item("定位直线3")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineBisecting1) '建立对称的第2个参数
Dim hybridShapeSymmetry1 As Object
Set hybridShapeSymmetry1 = hybridShapeFactory1.AddNewSymmetry(reference1, reference2) '建立对称特征
= "渐开线对称"
hybridShapeSymmetry1.V olumeResult = False '设置对称特征结果为曲面非体积
hybridBody1.AppendHybridShape hybridShapeSymmetry1
part1.InWorkObject = hybridShapeSymmetry1
part1.Update
Set hybridShapeSpline1 = hybridShapes1.Item("渐开线曲线") '绘制2点补充圆弧
Set reference1 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMCurve.1;2);None:(Li mits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSup port;MFBRepV ersion_CXR15)", hybridShapeSpline1)
Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线对称")
Set reference2 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMSymmetry.1;(Brp:(G SMCurve.1;2)));None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError ;WithSelectingFeatureSupport;MFBRepV ersion_CXR15)", hybridShapeSymmetry1) Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference3 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Dim hybridShapeCircle2PointsRad1 As Object
Set hybridShapeCircle2PointsRad1 = hybridShapeFactory1.AddNewCircle2PointsRad(reference1, reference2, reference3, False, ra + 20, 1)
= "圆弧2"
hybridBody1.AppendHybridShape hybridShapeCircle2PointsRad1
part1.InWorkObject = hybridShapeCircle2PointsRad1
part1.Update
'以下代码完成依据所提供参数绘制的渐开线齿槽的导角和接合过程
If rb > rf Then
Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("渐开线齿轮图形数据")
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapeSpline1 = hybridShapes1.Item("渐开线曲线")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1)
Set hybridShapePointOnPlane1 = hybridShapes1.Item("Point_1")
Set reference2 = part1.CreateReferenceFromObject(hybridShapePointOnPlane1)
Dim hybridShapeLineTangency1 As Object
Set hybridShapeLineTangency1 = hybridShapeFactory1.AddNewLineTangency(reference1, reference2, 0#, 20#, False)
Set hybridShapeCircleCtrRad1 = hybridShapes1.Item("齿根圆")
Set reference3 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1) hybridShapeLineTangency1.SecondUptoElem = reference3
hybridBody1.AppendHybridShape hybridShapeLineTangency1
part1.InWorkObject = hybridShapeLineTangency1
part1.Update
Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线对称")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSymmetry1)
Set reference2 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMSymmetry.1;(Brp:(G SMCurve.1;1)));None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildErro r;WithSelectingFeatureSupport;MFBRepV ersion_CXR15)", hybridShapeSymmetry1)
Dim hybridShapeLineTangency2 As Object
Set hybridShapeLineTangency2 = hybridShapeFactory1.AddNewLineTangency(reference1, reference2, 0#, 20#, False)
Set reference3 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)
hybridShapeLineTangency2.SecondUptoElem = reference3
hybridBody1.AppendHybridShape hybridShapeLineTangency2
part1.InWorkObject = hybridShapeLineTangency2
part1.Update
Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("渐开线齿轮图形数据")
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapeSpline1 = hybridShapes1.Item("渐开线曲线")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1)
Set hybridShapeLineTangency1 = hybridShapes1.Item("直线.4")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineTangency1)
Dim hybridShapeAssemble1 As Object
Set hybridShapeAssemble1 = hybridShapeFactory1.AddNewJoin(reference1, reference2)
hybridShapeAssemble1.SetConnex 1
hybridShapeAssemble1.SetManifold 1
hybridShapeAssemble1.SetSimplify 0
hybridShapeAssemble1.SetSuppressMode 0
hybridShapeAssemble1.SetDeviation 0.001
hybridShapeAssemble1.SetAngularToleranceMode 0
hybridShapeAssemble1.SetAngularTolerance 0.5
hybridShapeAssemble1.SetFederationPropagation 0
hybridBody1.AppendHybridShape hybridShapeAssemble1
part1.InWorkObject = hybridShapeAssemble1
part1.Update
Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线对称")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSymmetry1)
Set hybridShapeLineTangency2 = hybridShapes1.Item("直线.5")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineTangency2)
Dim hybridShapeAssemble2 As Object
Set hybridShapeAssemble2 = hybridShapeFactory1.AddNewJoin(reference1, reference2) hybridShapeAssemble2.SetConnex 1
hybridShapeAssemble2.SetManifold 1
hybridShapeAssemble2.SetSimplify 0
hybridShapeAssemble2.SetSuppressMode 0
hybridShapeAssemble2.SetDeviation 0.001
hybridShapeAssemble2.SetAngularToleranceMode 0
hybridShapeAssemble2.SetAngularTolerance 0.5
hybridShapeAssemble2.SetFederationPropagation 0
hybridBody1.AppendHybridShape hybridShapeAssemble2
part1.InWorkObject = hybridShapeAssemble2
part1.Update
Set originElements1 = part1.OriginElements
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set reference2 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMLine.4;1);None:(Limi ts1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupp ort;MFBRepV ersion_CXR15)", hybridShapeAssemble1)
Set reference3 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMLine.5;1);None:(Limi ts1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupp ort;MFBRepV ersion_CXR15)", hybridShapeAssemble2)
Set hybridShapeCircle2PointsRad1 = hybridShapeFactory1.AddNewCircle2PointsRad(reference2, reference3, reference1, False, 48.75, 1)
hybridShapeCircle2PointsRad1.SetLimitation 2
= "圆弧3"
hybridBody1.AppendHybridShape hybridShapeCircle2PointsRad1
part1.InWorkObject = hybridShapeCircle2PointsRad1
part1.Update
Set reference1 = part1.CreateReferenceFromObject(hybridShapeAssemble1)
Set reference2 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad1)
Dim hybridShapeCorner1 As Object
Set hybridShapeCorner1 = hybridShapeFactory1.AddNewCorner(reference1, reference2, Nothing, rb / zT, -1, 1, False)
hybridShapeCorner1.DiscriminationIndex = 1
hybridShapeCorner1.BeginOfCorner = 1
hybridShapeCorner1.FirstTangentOrientation = -1
hybridShapeCorner1.SecondTangentOrientation = 1
hybridShapeCorner1.TrimMode = 2
hybridShapeFactory1.GSMVisibility reference1, 0
hybridBody1.AppendHybridShape hybridShapeCorner1
part1.InWorkObject = hybridShapeCorner1
part1.Update
Set reference1 = part1.CreateReferenceFromObject(hybridShapeAssemble2)
Set reference2 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad1)
Dim hybridShapeCorner2 As Object
Set hybridShapeCorner2 = hybridShapeFactory1.AddNewCorner(reference1, reference2, Nothing, rb / zT, 1, 1, False)
hybridShapeCorner2.DiscriminationIndex = 1
hybridShapeCorner2.BeginOfCorner = 2
hybridShapeCorner2.FirstTangentOrientation = 1
hybridShapeCorner2.SecondTangentOrientation = 1
hybridShapeCorner2.TrimMode = 2
hybridShapeFactory1.GSMVisibility reference1, 0
hybridBody1.AppendHybridShape hybridShapeCorner2
part1.InWorkObject = hybridShapeCorner2
part1.Update
Set part1 = partDocument1.Part
Set originElements1 = part1.OriginElements
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("渐开线齿轮图形数据")
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapeCorner1 = hybridShapes1.Item("圆角.1")
Set reference2 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMCorner.1;2);None:(Li mits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSu pport;MFBRepV ersion_CXR15)", hybridShapeCorner1)
Set hybridShapeCorner2 = hybridShapes1.Item("圆角.2")
Set reference3 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMCorner.2;1);None:(Li mits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSu pport;MFBRepV ersion_CXR15)", hybridShapeCorner2)
Set hybridShapeCircle2PointsRad1 = hybridShapeFactory1.AddNewCircle2PointsRad(reference2, reference3, reference1, True, 100#, 1)
hybridShapeCircle2PointsRad1.SetLimitation 2
= "圆弧4"
hybridBody1.AppendHybridShape hybridShapeCircle2PointsRad1
part1.InWorkObject = hybridShapeCircle2PointsRad1
part1.Update
Dim hybridShapeCircle2PointsRad2 As Object
Set hybridShapeCircle2PointsRad2 = hybridShapes1.Item("圆弧2")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad2) Set reference2 = part1.CreateReferenceFromObject(hybridShapeCorner1)
Set hybridShapeAssemble1 = hybridShapeFactory1.AddNewJoin(reference1, reference2) Set reference3 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad1)
hybridShapeAssemble1.AddElement reference3
Dim reference4 As Object
Set reference4 = part1.CreateReferenceFromObject(hybridShapeCorner2) hybridShapeAssemble1.AddElement reference4
hybridShapeAssemble1.SetConnex 1
hybridShapeAssemble1.SetManifold 1
hybridShapeAssemble1.SetSimplify 0
hybridShapeAssemble1.SetSuppressMode 0
hybridShapeAssemble1.SetDeviation 0.001
hybridShapeAssemble1.SetAngularToleranceMode 0
hybridShapeAssemble1.SetAngularTolerance 0.5
hybridShapeAssemble1.SetFederationPropagation 0
= "渐开线完整切槽"
hybridBody1.AppendHybridShape hybridShapeAssemble1
part1.InWorkObject = hybridShapeAssemble1
part1.Update
part1.Update
Else
Set part1 = partDocument1.Part
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("渐开线齿轮图形数据")
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapeSpline1 = hybridShapes1.Item("渐开线曲线")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1)
Set hybridShapeCircleCtrRad1 = hybridShapes1.Item("齿根圆")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapeCorner1 = hybridShapeFactory1.AddNewCorner(reference1, reference2, Nothing, 1#, -1, 1, False)
hybridShapeCorner1.DiscriminationIndex = 1
hybridShapeCorner1.BeginOfCorner = 1
hybridShapeCorner1.FirstTangentOrientation = -1
hybridShapeCorner1.SecondTangentOrientation = 1
hybridShapeCorner1.TrimMode = 2
hybridShapeFactory1.GSMVisibility reference1, 0
hybridBody1.AppendHybridShape hybridShapeCorner1
part1.InWorkObject = hybridShapeCorner1
part1.Update
Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线对称")
Set reference3 = part1.CreateReferenceFromObject(hybridShapeSymmetry1)
Set reference4 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)
Set hybridShapeCorner2 = hybridShapeFactory1.AddNewCorner(reference3, reference4, Nothing, 1#, 1, 1, False)
hybridShapeCorner2.DiscriminationIndex = 1
hybridShapeCorner2.BeginOfCorner = 2
hybridShapeCorner2.FirstTangentOrientation = 1
hybridShapeCorner2.SecondTangentOrientation = 1
hybridShapeCorner2.TrimMode = 2
hybridShapeFactory1.GSMVisibility reference3, 0
hybridBody1.AppendHybridShape hybridShapeCorner2
part1.InWorkObject = hybridShapeCorner2
part1.Update
Set part1 = partDocument1.Part
Set originElements1 = part1.OriginElements
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item("渐开线齿轮图形数据")
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapeCorner1 = hybridShapes1.Item("圆角.1")
Set reference2 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMCorner.1;2);None:(Li mits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSu pport;MFBRepV ersion_CXR15)", hybridShapeCorner1)
Set hybridShapeCorner2 = hybridShapes1.Item("圆角.2")
Set reference3 = part1.CreateReferenceFromBRepName("BorderFV ertex:(BEdge:(Brp:(GSMCorner.2;1);None:(Li mits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSu pport;MFBRepV ersion_CXR15)", hybridShapeCorner2)
Set hybridShapeCircle2PointsRad1 = hybridShapeFactory1.AddNewCircle2PointsRad(reference2, reference3, reference1, False, 100#, 1)
hybridShapeCircle2PointsRad1.SetLimitation 2
= "圆弧3"
hybridBody1.AppendHybridShape hybridShapeCircle2PointsRad1
part1.InWorkObject = hybridShapeCircle2PointsRad1
part1.Update
Set hybridShapeCircle2PointsRad1 = hybridShapes1.Item("圆弧2")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad1)
Set hybridShapeCorner1 = hybridShapes1.Item("圆角.2")
Set reference2 = part1.CreateReferenceFromObject(hybridShapeCorner1)
Set hybridShapeAssemble1 = hybridShapeFactory1.AddNewJoin(reference1, reference2)
Set hybridShapeCircle2PointsRad2 = hybridShapes1.Item("圆弧3")
Set reference3 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad2)
hybridShapeAssemble1.AddElement reference3
Set hybridShapeCorner2 = hybridShapes1.Item("圆角.1")
Set reference4 = part1.CreateReferenceFromObject(hybridShapeCorner2) hybridShapeAssemble1.AddElement reference4
hybridShapeAssemble1.SetConnex 1
hybridShapeAssemble1.SetManifold 1
hybridShapeAssemble1.SetSimplify 0
hybridShapeAssemble1.SetSuppressMode 0
hybridShapeAssemble1.SetDeviation 0.001
hybridShapeAssemble1.SetAngularToleranceMode 0
hybridShapeAssemble1.SetAngularTolerance 0.5
hybridShapeAssemble1.SetFederationPropagation 0
= "渐开线完整切槽"
hybridBody1.AppendHybridShape hybridShapeAssemble1
part1.InWorkObject = hybridShapeAssemble1
part1.Update
End If
'以下代码将完成齿轮主体（即齿顶圆高度）的实体拉伸操作
Dim bodies1 As Object
Set bodies1 = part1.Bodies
Dim body1 As Object
Set body1 = bodies1.Item("零件几何体")
= "零件实体"
part1.InWorkObject = body1 '在执行相应特征操作前先应设置Catia工作于对应的命令种类下
Set hybridShapeCircleCtrRad1 = hybridShapes1.Item("齿顶圆")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)
Dim pad1 As Object
Dim shapeFactory1 As Object
Set shapeFactory1 = part1.ShapeFactory
Set pad1 = shapeFactory1.AddNewPadFromRef(reference1, B) '拉伸齿轮实体
= "齿轮实体"
part1.Update
'以下代码将完成齿轮渐开线齿廓的开槽功能
If Abs(bT) < 0.0001 Or LOrR = 0 Then '齿轮斜角为直齿的情况
Dim pocket1 As Object '添加渐开线齿槽
Set shapeFactory1 = part1.ShapeFactory
Set hybridShapeAssemble1 = hybridShapes1.Item("渐开线完整切槽")
Set reference1 = part1.CreateReferenceFromObject(hybridShapeAssemble1)
Set pocket1 = shapeFactory1.AddNewPocketFromRef(reference1, B)
part1.InWorkObject = pocket1
= "完整齿槽"
part1.Update
Else '余下的为斜齿的情况，左旋与右旋定义螺旋线(Helix)的旋向不同即可Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线对称") '绘制交点
Set reference1 = part1.CreateReferenceFromObject(hybridShapeSymmetry1)
Set reference2 = part1.CreateReferenceFromBRepName("REdge:(Edge:(Face:(Brp:(Pad.1;1);None:();Cf11:());Fac e:(Brp:(Pad.1;0:(Brp:(GSMCircle.4)));None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());Wit hPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRep V ersion_CXR15)", pad1)
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2)
hybridShapeIntersection1.PointType = 1 '设置运算结果为点
= "定位交点"
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
part1.Update
Set originElements1 = part1.OriginElements
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)。