Option Explicit

Option Base 1

Public z As Double '齿数

Public m As Double '齿轮模数

Public a As Double '齿轮压力角

Public r As Double '齿轮分度圆半径

Public rf As Double '齿根圆半径

Public rb As Double '基圆半径

Public rk As Double '齿顶圆半径

Public xt As Double '设置临时坐标变量

Public yt As Double

Public index As Double '循环变量

Public pitchT As Double

Public dataT() As Double '齿轮模数数据

Public dataT2() As Double

Public Const PI# = 3.14159265358979

Sub CATMain() '齿轮创建程序主入口

UserForm1.Show '进入用户窗口

End Sub

Public Function CreateGeneralGear(ByVal mT As Double, ByVal zT As Double, ByVal aT As Double, ByVal bT As Double, ByVal B As Double, ByVal 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

rk = r + 1 * mT

If Not (Abs(bT) < 0.0001 Or LOrR = 0) Then pitchT = 2 * PI * rk * Tan((90 - bT) * PI / 180)

Dim documents1 As Documents '为后续数据层做准备

Set documents1 = CATIA.Documents

Dim partDocument1 As PartDocument

Set partDocument1 = documents1.Add("Part")

Dim part1 As Part

Set part1 = partDocument1.Part

Dim originElements1 As OriginElements

Set originElements1 = part1.OriginElements

Dim hybridBodies1 As HybridBodies

Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody

Set hybridBody1 = hybridBodies1.Add()

hybridBody1.Name = "渐开线齿轮图形数据"

Dim hybridShapeFactory1 As HybridShapeFactory

Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapePointCoord1 As HybridShapePointCoord

Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)

hybridShapePointCoord1.Name = "原点"

hybridBody1.AppendHybridShape hybridShapePointCoord1 '添加所添加的原点

part1.Update

Dim reference1 As Reference

Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1) '新建一个参考点（圆心）

Dim hybridShapePlaneExplicit1 As HybridShapePlaneExplicit

Set hybridShapePlaneExplicit1 = originElements1.PlaneXY

Dim reference2 As Reference

Set reference2 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1) '新建一个参考平面，定义在originElements类中决定

Dim hybridShapeCircleCtrRad1 As HybridShapeCircleCtrRad

Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, r) '据中心点和参考面,半径画分度圆

hybridShapeCircleCtrRad1.Name = "分度圆"

hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1 '在当前模型中显示已在数据层面添加的模型

Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, rb) '画基圆

hybridShapeCircleCtrRad1.Name = "基圆"

hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1

Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, rf) '画齿根圆

hybridShapeCircleCtrRad1.Name = "齿根圆"

hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1

Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, rk) '画齿顶圆

hybridShapeCircleCtrRad1.Name = "齿顶圆"

hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1

part1.Update

Set hybridShapePlaneExplicit1 = originElements1.PlaneXY

Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)

Dim hybridShapePointOnPlane1 As HybridShapePointOnPlane '通过循环的方法画由15个点组成的渐开线

For index = 0 To 18

Set hybridShapePointOnPlane1 = hybridShapeFactory1.AddNewPointOnPlane(reference1, EvaluateX(rb, index * 0.03), EvaluateY(rb, index * 0.03)) '用曲面库类(hybridshapefactory)的方法在所选参考平面上新建各渐开线点

hybridShapePointOnPlane1.Name = "Point_" & CStr(index + 1)

hybridBody1.AppendHybridShape hybridShapePointOnPlane1

Next index

part1.Update '更新当前零部件几何体

Dim hybridShapeSpline1 As HybridShapeSpline

Set hybridShapeSpline1 = hybridShapeFactory1.AddNewSpline()

hybridShapeSpline1.SetClosing 0 '设置样条曲线封闭样式为0（0为不封闭）

hybridShapeSpline1.SetSplineType 0 '设置样条曲线投影样式0为不投影，否则应额外设置相应的reference平面变量

Dim hybridShapes1 As HybridShapes

Set hybridShapes1 = hybridBody1.HybridShapes

For index = 2 To 20

Set hybridShapePointOnPlane1 = hybridShapes1.Item("Point_" & CStr(index - 1))

Set reference1 = part1.CreateReferenceFromObject(hybridShapePointOnPlane1)

hybridShapeSpline1.AddPointWithConstraintExplicit reference1, Nothing, -1#, 1, Nothing, 0# '顺序添加参考约束点以绘制样条曲线spline

Next index

hybridShapeSpline1.Name = "渐开线齿廓曲线"

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 HybridShapeIntersection

Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2)

hybridShapeIntersection1.Name = "分度圆交点"

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 HybridShapeLinePtPt

Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2)

hybridShapeLinePtPt1.Name = "定位直线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 Reference

Set hybridShapePlaneExplicit1 = originElements1.PlaneXY

Set reference3 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)

Dim hybridShapeCircleCtrPt1 As HybridShapeCircleCtrPt

Set hybridShapeCircleCtrPt1 = hybridShapeFactory1.AddNewCircleCtrPtWithAngles(reference1, reference2, reference3, False, 0#, 360 / zT / 2)

hybridShapeCircleCtrPt1.Name = "定位圆弧1"

hybridBody1.AppendHybridShape hybridShapeCircleCtrPt1

part1.Update

Set hybridShapePointCoord1 = hybridShapes1.Item("原点") '画定位直线2

Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)

Set reference2 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(GSMCircle.5;2);None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeCircleCtrPt1)

Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference1, reference2)

hybridShapeLinePtPt1.Name = "定位直线2"

hybridBody1.AppendHybridShape hybridShapeLinePtPt1

part1.Update

Set hybridShapeLinePtPt1 = hybridShapes1.Item("定位直线1")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)

Dim hybridShapeLinePtPt2 As HybridShapeLinePtPt

Set hybridShapeLinePtPt2 = hybridShapes1.Item("定位直线2")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeLinePtPt2)

Dim hybridShapeLineBisecting1 As HybridShapeLineBisecting

Set hybridShapeLineBisecting1 = hybridShapeFactory1.AddNewLineBisecting(reference1, reference2, 0#, rk + 10, False, 1)

hybridShapeLineBisecting1.Name = "定位直线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 HybridShapeSymmetry

Set hybridShapeSymmetry1 = hybridShapeFactory1.AddNewSymmetry(reference1, reference2) '建立对称特征

hybridShapeSymmetry1.Name = "渐开线齿廓对称"

hybridShapeSymmetry1.VolumeResult = False '设置对称特征结果为曲面非体积

hybridBody1.AppendHybridShape hybridShapeSymmetry1

part1.InWorkObject = hybridShapeSymmetry1

part1.Update

Set hybridShapeSpline1 = hybridShapes1.Item("渐开线齿廓曲线") '绘制2点补充圆弧

Set reference1 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(GSMCurve.1;2);None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeSpline1)

Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线齿廓对称")

Set reference2 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(GSMSymmetry.1;(Brp:(GSMCurve.1;2)));None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeSymmetry1)

Set hybridShapePlaneExplicit1 = originElements1.PlaneXY

Set reference3 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)

Dim hybridShapeCircle2PointsRad1 As HybridShapeCircle2PointsRad

Set hybridShapeCircle2PointsRad1 = hybridShapeFactory1.AddNewCircle2PointsRad(reference1, reference2, reference3, False, rk + 20, 1)

hybridShapeCircle2PointsRad1.Name = "补充圆弧1"

hybridBody1.AppendHybridShape hybridShapeCircle2PointsRad1

part1.InWorkObject = hybridShapeCircle2PointsRad1

part1.Update

'以下代码完成依据所提供参数绘制的渐开线齿槽的导角和接合过程

Set hybridShapeSpline1 = hybridShapes1.Item("渐开线齿廓曲线")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1)

Set hybridShapeCircleCtrRad1 = hybridShapes1.Item("基圆")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)

Dim hybridShapeCorner1 As HybridShapeCorner

Set hybridShapeCorner1 = hybridShapeFactory1.AddNewCorner(reference1, reference2, Nothing, rb / 30, -1, 1, False)

hybridShapeCorner1.Name = "倒圆角1"

hybridBody1.AppendHybridShape hybridShapeCorner1

part1.Update

Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线齿廓对称")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeSymmetry1)

Set hybridShapeCircleCtrRad1 = hybridShapes1.Item("基圆")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)

Set hybridShapeCorner1 = hybridShapeFactory1.AddNewCorner(reference1, reference2, Nothing, rb / 30, 1, 1, False)

hybridShapeCorner1.Name = "倒圆角2"

hybridBody1.AppendHybridShape hybridShapeCorner1

part1.InWorkObject = hybridShapeCorner1

part1.Update

Set hybridShapeSpline1 = hybridShapes1.Item("渐开线齿廓曲线")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeSpline1)

Set hybridShapeCorner1 = hybridShapes1.Item("倒圆角1")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeCorner1)

Dim hybridShapeSplit1 As HybridShapeSplit

Set hybridShapeSplit1 = hybridShapeFactory1.AddNewHybridSplit(reference1, reference2, -1)

hybridShapeSplit1.Name = "截除曲线1"

hybridBody1.AppendHybridShape hybridShapeSplit1

part1.Update

Set hybridShapeSymmetry1 = hybridShapes1.Item("渐开线齿廓对称")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeSymmetry1)

Set hybridShapeCorner1 = hybridShapes1.Item("倒圆角2")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeCorner1)

Set hybridShapeSplit1 = hybridShapeFactory1.AddNewHybridSplit(reference1, reference2, -1)

hybridShapeSplit1.Name = "截除曲线2"

hybridBody1.AppendHybridShape hybridShapeSplit1

part1.InWorkObject = hybridShapeSplit1

part1.Update '以下将建立基于2点和半径的补充圆弧

Dim hybridShapeCorner2 As HybridShapeCorner

Set hybridShapeCorner2 = hybridShapes1.Item("倒圆角2")

Set hybridShapeCorner1 = hybridShapes1.Item("倒圆角1")

Set reference1 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(GSMCorner.2;1);None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeCorner2)

Set reference2 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(GSMCorner.1;2);None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", hybridShapeCorner1)

Set originElements1 = part1.OriginElements

Set hybridShapePlaneExplicit1 = originElements1.PlaneXY

Set reference3 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)

Set hybridShapeCircle2PointsRad1 = hybridShapeFactory1.AddNewCircle2PointsRad(reference1, reference2, reference3, False, rb, 1)

hybridShapeCircle2PointsRad1.Name = "补充圆弧2"

hybridBody1.AppendHybridShape hybridShapeCircle2PointsRad1

part1.InWorkObject = hybridShapeCircle2PointsRad1

part1.Update '以下将完成以上步骤所绘制曲线的接合，以形成最终的渐开线齿槽

Set hybridShapeCircle2PointsRad1 = hybridShapes1.Item("补充圆弧1")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad1)

Set hybridShapeSplit1 = hybridShapes1.Item("截除曲线1")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeSplit1)

Dim hybridShapeAssemble1 As HybridShapeAssemble

Set hybridShapeAssemble1 = hybridShapeFactory1.AddNewJoin(reference1, reference2)

Set hybridShapeCorner1 = hybridShapes1.Item("倒圆角1")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeCorner1)

hybridShapeAssemble1.AddElement reference1 '添加其余接合约束

Set hybridShapeCircle2PointsRad1 = hybridShapes1.Item("补充圆弧2")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircle2PointsRad1)

hybridShapeAssemble1.AddElement reference1

Set hybridShapeCorner1 = hybridShapes1.Item("倒圆角2")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeCorner1)

hybridShapeAssemble1.AddElement reference1

Set hybridShapeSplit1 = hybridShapes1.Item("截除曲线2")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeSplit1)

hybridShapeAssemble1.AddElement reference1

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

hybridShapeAssemble1.Name = "渐开线齿槽"

hybridBody1.AppendHybridShape hybridShapeAssemble1

part1.InWorkObject = hybridShapeAssemble1

part1.Update

'以下代码将完成齿轮主体（即齿顶圆高度）的实体拉伸操作

Dim bodies1 As Bodies

Set bodies1 = part1.Bodies

Dim body1 As Body

Set body1 = bodies1.Item("零部件几何体")

body1.Name = "零件实体"

part1.InWorkObject = body1 '在执行相应特征操作前先应设置Catia工作于对应的命令种类下

Set hybridShapeCircleCtrRad1 = hybridShapes1.Item("齿顶圆")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)

Dim pad1 As Pad

Dim shapeFactory1 As ShapeFactory

Set shapeFactory1 = part1.ShapeFactory

Set pad1 = shapeFactory1.AddNewPadFromRef(reference1, B) '拉伸齿轮实体

pad1.Name = "齿轮实体"

part1.Update

'以下代码将完成齿轮渐开线齿廓的开槽功能

If Abs(bT) < 0.0001 Or LOrR = 0 Then '齿轮斜角为直齿的情况

Dim pocket1 As Pocket '添加渐开线齿槽

Set shapeFactory1 = part1.ShapeFactory

Set hybridShapeAssemble1 = hybridShapes1.Item("渐开线齿槽")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeAssemble1)

Set pocket1 = shapeFactory1.AddNewPocketFromRef(reference1, B + 5)

Dim limit1 As Limit '为避免单单用参数化的形式可能造成的反向错误，将其设为穿透模式

Set limit1 = pocket1.FirstLimit

limit1.LimitMode = catUpThruNextLimit '设置穿透形式为直到下一对象(平面或曲面)

part1.InWorkObject = pocket1

pocket1.Name = "完整齿槽"

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:());Face:(Brp:(Pad.1;0:(Brp:(GSMCircle.4)));None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)

Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2)

hybridShapeIntersection1.PointType = 1 '设置运算结果为点

hybridShapeIntersection1.Name = "定位交点"

hybridBody1.AppendHybridShape hybridShapeIntersection1

part1.InWorkObject = hybridShapeIntersection1

part1.Update

Set originElements1 = part1.OriginElements

Set hybridShapePlaneExplicit1 = originElements1.PlaneXY

Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)

Set hybridShapePointCoord1 = hybridShapes1.Item("原点")

Set reference2 = part1.CreateReferenceFromObject(hybridShapePointCoord1)

Dim hybridShapeLineNormal1 As HybridShapeLineNormal

Set hybridShapeLineNormal1 = hybridShapeFactory1.AddNewLineNormal(reference1, reference2, 0#, B + 10, True)

hybridShapeLineNormal1.Name = "螺旋线轴线"

hybridBody1.AppendHybridShape hybridShapeLineNormal1

part1.InWorkObject = hybridShapeLineNormal1

part1.Update

Set hybridShapeIntersection1 = hybridShapes1.Item("定位交点")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeIntersection1)

Set hybridShapeLineNormal1 = hybridShapes1.Item("螺旋线轴线")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeLineNormal1)

Dim hybridShapeHelix1 As HybridShapeHelix

Set hybridShapeHelix1 = hybridShapeFactory1.AddNewHelix(reference2, True, reference1, pitchT, B + 10, IIf(LOrR = 1, True, False), 0#, 0#, False)

hybridShapeHelix1.Name = "螺旋曲线"

hybridBody1.AppendHybridShape hybridShapeHelix1

part1.InWorkObject = hybridShapeHelix1

part1.Update

Set hybridShapes1 = hybridBody1.HybridShapes

Set hybridShapeAssemble1 = hybridShapes1.Item("渐开线齿槽")

Set reference1 = part1.CreateReferenceFromObject(hybridShapeAssemble1)

Set hybridShapeHelix1 = hybridShapes1.Item("螺旋曲线")

Set reference2 = part1.CreateReferenceFromObject(hybridShapeHelix1)

Dim slot1 As slot

Set shapeFactory1 = part1.ShapeFactory

Set body1 = bodies1.Item("零件实体")

part1.InWorkObject = body1 '由于切换了工作模式需要改变模式为实体工作模式

Set slot1 = shapeFactory1.AddNewSlotFromRef(reference1, reference2)

part1.Update

End If

'以下代码将完成开槽操作的圆模式以最终完成渐开线齿形

Set hybridShapePointCoord1 = hybridShapes1.Item("原点")

Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)

Set bodies1 = part1.Bodies

Set body1 = bodies1.Item("零件实体")

Set pad1 = body1.Shapes.Item("齿轮实体")

Set reference2 = part1.CreateReferenceFromBRepName("FSur:(Face:(Brp:(Pad.1;1);None:();Cf11:());WithTemporaryBody;WithoutBuildError;WithInitialFeatureSupport;MFBRepVersion_CXR15)", pad1)

Dim circlePatten1 As CircPattern

If Abs(bT) < 0.0001 Or LOrR = 0 Then Set pocket1 = body1.Shapes.Item("完整齿槽")

Set circlePatten1 = shapeFactory1.AddNewCircPattern(IIf(Abs(bT) < 0.0001 Or LOrR = 0, pocket1, slot1), 1, zT, 20#, 360 / zT, 1, 1, reference1, reference2, True, 0#, True)

circlePatten1.Name = "环形阵列"

part1.InWorkObject = circlePatten1

part1.Update

'最后需要完成对象的消隐工作

Dim selection1 As Selection

Set selection1 = partDocument1.Selection

Dim visPropertySet1 As VisPropertySet

Set visPropertySet1 = selection1.VisProperties

selection1.Add hybridBody1

visPropertySet1.SetShow 1

part1.Update

End Function

Public Function EvaluateX(ByVal rbT As Double, ByVal 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(ByVal rbT As Double, ByVal t As Double) As Double '这里的参数t取值也为0~1

EvaluateY = rbT * Cos(t * PI / 2) + rbT * PI * t / 2 * Sin(t * PI / 2)

End Function