Private Sub cmdCreate_Click()
Dim x As Variant, y As Variant, t As Double Const pi = 3.14
' 连接到CATIA，如果CATIA未启动，启动它 Dim CATIA As Object
On Error Resume Next
Set CATIA = GetObject(, \ If Err.Number <> 0 Then
Set CATIA = CreateObject(\ CATIA.Visible = True End If
On Error GoTo 0
Set documents1 = CATIA.Documents
Set partDocument1 = documents1.Add(\
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item(\
Set body2 = bodies1.Add
Set product1 = partDocument1.GetItem(\
product1.PartNumber = \
part1.Update
'：绘制一条直线作为旋转轴用和Z轴重合
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item(\
hybridBody1.AppendHybridShape hybridShapePointCoord1
part1.InWorkObject = hybridShapePointCoord1
part1.Update
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1)
Set hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 1#)
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(reference1, hybridShapeDirection1, 0#, 20#, False)
hybridBody1.AppendHybridShape hybridShapeLinePtDir1
part1.InWorkObject = hybridShapeLinePtDir1
part1.Update
'：设置 f(x) 和 relations
Set parameters1 = part1.Parameters
Set Length1 = parameters1.CreateDimension(\
Length1.Rename \分度圆直径dp\
Set parameters2 = part1.Parameters
Set Length2 = parameters2.CreateDimension(\
Length2.Rename \齿顶高ha\
Set parameters3 = part1.Parameters
Set length3 = parameters3.CreateDimension(\
length3.Rename \齿根高hf\
Set parameters4 = part1.Parameters
Set length4 = parameters4.CreateDimension(\
length4.Rename \齿全高h\
Set parameters5 = part1.Parameters
Set length5 = parameters5.CreateDimension(\
length5.Rename \齿顶圆直径da\
Set parameters6 = part1.Parameters
Set length6 = parameters6.CreateDimension(\
length6.Rename \齿根圆直径df\
Set parameters7 = part1.Parameters
Set length7 = parameters7.CreateDimension(\
length7.Rename \基圆直径db\
Set parameters8 = part1.Parameters
Set length8 = parameters8.CreateDimension(\
length8.Rename \端面模数mt\
Set parameters9 = part1.Parameters
Set angle1 = parameters9.CreateDimension(\
angle1.Rename \端面压力角at\
Set parameters10 = part1.Parameters
Set realParam1 = parameters10.CreateReal(\
realParam1.Rename \端面齿顶高系数hat\
Set parameters11 = part1.Parameters
Set realParam2 = parameters11.CreateReal(\
realParam2.Rename \端面顶隙系数ct\
Set parameters12 = part1.Parameters
Set length9 = parameters12.CreateDimension(\
length9.Rename \法面模数mn\
length9.Value = Val(txtMod.Text)
Set parameters13 = part1.Parameters
Set angle2 = parameters13.CreateDimension(\
angle2.Rename \螺旋角β\
angle2.Value = Val(Text1.Text)
Set parameters14 = part1.Parameters
Set realParam3 = parameters14.CreateReal(\
realParam3.Rename \齿轮齿数z\
realParam3.Value = Val(txtCount.Text)
Set parameters15 = part1.Parameters
Set angle3 = parameters15.CreateDimension(\
angle3.Rename \法面压力角an\
angle3.Value = Val(txtAng.Text)
Set parameters16 = part1.Parameters
Set realParam4 = parameters16.CreateReal(\
realParam4.Rename \法面齿顶高系数han\
realParam4.Value = 1#
Set parameters17 = part1.Parameters
Set realParam5 = parameters17.CreateReal(\
realParam5.Rename \法面顶隙系数cn\
realParam5.Value = 0.25
Set parameters18 = part1.Parameters
Set length10 = parameters18.CreateDimension(\
length10.Rename \齿轮宽B\
length10.Value = Val(txtDis.Text)
Set parameters19 = part1.Parameters
Set parameters21 = part1.Parameters
Set parameters22 = part1.Parameters
Set length14 = parameters22.CreateDimension(\
length14.Rename \齿顶圆倒角n1\
Set parameters23 = part1.Parameters
Set length15 = parameters23.CreateDimension(\
length15.Rename \齿根圆角rf\
Set relations1 = part1.Relations
Set formula1 = relations1.CreateFormula(\端面模数mt` *`齿轮齿数z` \
formula1.Rename \
Set relations2 = part1.Relations
Set formula2 = relations2.CreateFormula(\端面模数mt` *`端面齿顶高系数hat` \
formula2.Rename \
Set relations3 = part1.Relations
Set formula3 = relations3.CreateFormula(\端面模数mt` *(`端面顶隙系数ct` +`端面齿顶高系数hat` )\
formula3.Rename \
Set relations4 = part1.Relations
Set formula4 = relations4.CreateFormula(\齿顶高ha` +`齿根高hf` \
formula4.Rename \
Set relations5 = part1.Relations
Set formula5 = relations5.CreateFormula(\法面模数mn` /cos(`螺旋角β` )\
formula5.Rename \
Set relations6 = part1.Relations
Set formula6 = relations6.CreateFormula(\\angle1, \法面压力角an` )/cos(`螺旋角β` ))\
formula6.Rename \
Set relations7 = part1.Relations
Set formula7 = relations7.CreateFormula(\\realParam1, \法面齿顶高系数han` *cos(`螺旋角β` )\
formula7.Rename \
Set relations8 = part1.Relations
Set formula8 = relations8.CreateFormula(\\realParam2, \法面顶隙系数cn` *cos(`螺旋角β` )\
formula8.Rename \
Set relations9 = part1.Relations
Set formula9 = relations9.CreateFormula(\法面模数mn` \
formula9.Rename \
Set relations10 = part1.Relations
Set formula10 = relations10.CreateFormula(\端面模数mt` \
formula10.Rename \
Set relations11 = part1.Relations
Set formula11 = relations11.CreateFormula(\\length5, \分度圆直径dp` +2*`齿顶高ha` \
formula11.Rename \
Set relations12 = part1.Relations
Set formula12 = relations12.CreateFormula(\分度圆直径dp` -2*`齿根高hf` \
formula12.Rename \
Set relations13 = part1.Relations
Set formula13 = relations13.CreateFormula(\\length7, \分度圆直径dp` *cos(`端面压力角at` )\
formula13.Rename \
'定义x，y，t。relations
part1.Update
Dim w As Integer
If Val(txtCount.Text) < 2 * realParam1.Value / (Sin(angle1.Value) * Sin(angle1.Value)) Then w = MsgBox(\齿数太小\ If w = 1 Then End End If End If
'目的：创建齿顶圆和 pad
part1.InWorkObject = hybridBody1
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item(\Set.1\ '定义为：Geometrical Set.1
hybridBody1.AppendHybridShape hybridShapePointCoord1
part1.InWorkObject = hybridShapePointCoord1
part1.Update
part1.InWorkObject = hybridBody1
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1) '原点作为参考
Set originElements1 = part1.OriginElements
Set hybridShapePlaneExplicit1
= originElements1.PlaneXY
'xy平面作为参考平面
Set reference2 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeCircleCtrRad1 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, length5.Value) '以原点为圆心，半径为齿顶圆54在xy平面做圆在程序中名字为：hybridShapeCircleCtrRad1
hybridShapeCircleCtrRad1.DiameterMode = True '将圆设置为直径显示模式
hybridShapeCircleCtrRad1.SetLimitation 1 '直径约束为齿顶圆da
Set relations21 = part1.Relations
Set diameter1 = hybridShapeCircleCtrRad1.Diameter
Set formula19 = relations21.CreateFormula(\分度圆直径dp` +2*`齿顶高ha` \
formula19.Rename \
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad1
part1.InWorkObject = hybridShapeCircleCtrRad1
part1.Update
part1.InWorkObject = body1
Set shapeFactory1 = part1.ShapeFactory
Set reference3 = part1.CreateReferenceFromName(\
Set pad1 = shapeFactory1.AddNewPadFromRef(reference3, 20#)
Set reference4 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad1)
pad1.SetProfileElement reference4
pad1.DirectionOrientation = catInverseOrientation
Set relations16 = part1.Relations
Set limit1 = pad1.FirstLimit
Set length16 = limit1.Dimension
Set formula14 = relations16.CreateFormula(\齿轮宽B` \
formula14.Rename \
part1.UpdateObject pad1
part1.Update
'目的 ：创建上一步 pad 的 chamfer
Set reference5 = part1.CreateReferenceFromName(\
Set chamfer1 = shapeFactory1.AddNewChamfer(reference5, catTangencyChamfer, catLengthAngleChamfer, catNoReverseChamfer, 1#, 45#)
Set reference6 = part1.CreateReferenceFromBRepName(\11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)\
chamfer1.AddElementToChamfer reference6
chamfer1.Mode = catLengthAngleChamfer
chamfer1.Propagation = catTangencyChamfer
chamfer1.Orientation = catNoReverseChamfer
Set reference7 = part1.CreateReferenceFromBRepName(\yBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)\
chamfer1.AddElementToChamfer reference7
chamfer1.Mode = catLengthAngleChamfer
chamfer1.Propagation = catTangencyChamfer
chamfer1.Orientation = catNoReverseChamfer
Set reference8 = part1.CreateReferenceFromBRepName(\yBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)\
chamfer1.AddElementToChamfer reference8
chamfer1.Mode = catLengthAngleChamfer
chamfer1.Propagation = catTangencyChamfer
chamfer1.Orientation = catNoReverseChamfer
Set relations17 = part1.Relations
Set parameters24 = part1.Parameters
Set length17 = parameters24.Item(\
Set formula15 = relations17.CreateFormula(\齿顶圆倒角n1` \
formula15.Rename \
part1.Update
'目的：绘制分度圆，齿顶圆，齿根圆，基圆。
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePointCoord2 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item(\
hybridBody1.AppendHybridShape hybridShapePointCoord2
part1.InWorkObject = hybridShapePointCoord2
part1.Update
Set reference9 = part1.CreateReferenceFromObject(hybridShapePointCoord2)
Set originElements1 = part1.OriginElements
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference10 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeCircleCtrRad2 = hybridShapeFactory1.AddNewCircleCtrRad(reference9, reference10, False, Length1.Value)
hybridShapeCircleCtrRad2.DiameterMode = True
hybridShapeCircleCtrRad2.SetLimitation 1
Set relations22 = part1.Relations
Set diameter2 = hybridShapeCircleCtrRad2.Diameter
Set formula20 = relations22.CreateFormula(\端面模数mt` *`齿轮齿数z` \
formula20.Rename \
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad2
part1.InWorkObject = hybridShapeCircleCtrRad2
part1.Update
Set hybridShapePointCoord3 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
hybridBody1.AppendHybridShape hybridShapePointCoord3
part1.InWorkObject = hybridShapePointCoord3
part1.Update
Set reference11 = part1.CreateReferenceFromObject(hybridShapePointCoord3)
Set reference12 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeCircleCtrRad3 = hybridShapeFactory1.AddNewCircleCtrRad(reference11, reference12, False, length5.Value)
hybridShapeCircleCtrRad3.DiameterMode = True
hybridShapeCircleCtrRad3.SetLimitation 1
Set relations23 = part1.Relations
Set diameter3 = hybridShapeCircleCtrRad3.Diameter
Set formula21 = relations23.CreateFormula(\分度圆直径dp` +2*`齿顶高ha` \
formula21.Rename \
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad3
part1.InWorkObject = hybridShapeCircleCtrRad3
part1.Update
Set hybridShapePointCoord4 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
hybridBody1.AppendHybridShape hybridShapePointCoord4
part1.InWorkObject = hybridShapePointCoord4
part1.Update
Set reference13 = part1.CreateReferenceFromObject(hybridShapePointCoord4)
Set reference14 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeCircleCtrRad4 = hybridShapeFactory1.AddNewCircleCtrRad(reference13, reference14, False, length6.Value)
hybridShapeCircleCtrRad4.DiameterMode = True
hybridShapeCircleCtrRad4.SetLimitation 1
Set relations24 = part1.Relations
Set diameter4 = hybridShapeCircleCtrRad4.Diameter
Set formula22 = relations24.CreateFormula(\分度圆直径dp` -2*`齿根高hf` \
formula22.Rename \
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad4
part1.InWorkObject = hybridShapeCircleCtrRad4
part1.Update
Set hybridShapePointCoord5 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
hybridBody1.AppendHybridShape hybridShapePointCoord5
part1.InWorkObject = hybridShapePointCoord5
part1.Update
Set reference15 = part1.CreateReferenceFromObject(hybridShapePointCoord5)
Set reference16 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeCircleCtrRad5 = hybridShapeFactory1.AddNewCircleCtrRad(reference15, reference16, False, length7.Value)
hybridShapeCircleCtrRad5.DiameterMode = True
hybridShapeCircleCtrRad5.SetLimitation 1
Set relations25 = part1.Relations
Set diameter5 = hybridShapeCircleCtrRad5.Diameter
Set formula23 = relations25.CreateFormula(\分度圆直径dp` *cos(`端面压力角at` )\
formula23.Rename \
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad5
part1.InWorkObject = hybridShapeCircleCtrRad5
part1.Update
Dim ckq(20) As Double Dim ckq1(20) As Double i = 0 t = 0
For t = o To 0.5 Step 1 / 40
ckq(i) = 0.5 * length7.Value * Cos(t * pi) + 0.5 * length7.Value * Sin(t * pi) * t * pi ckq1(i) = 0.5 * length7.Value * Sin(t * pi) - 0.5 * length7.Value * Cos(t * pi) * t * pi
'自己编写如下取他 为以下值 0.02、0.04、0.08、0.12、0.15、0.2、0.3、0.4、0.5
'目的：绘制10个点 i = i + 1 Next t
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference14 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane1 hybridShapeFactory1.AddNewPointOnPlane(reference14, ckq(0), ckq1(0)) hybridBody1.AppendHybridShape hybridShapePointOnPlane1
part1.InWorkObject = hybridShapePointOnPlane1
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference15 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane2 hybridShapeFactory1.AddNewPointOnPlane(reference15, ckq(2), ckq1(2))
hybridBody1.AppendHybridShape hybridShapePointOnPlane2
part1.InWorkObject = hybridShapePointOnPlane2
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
= = Set reference16 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane3
hybridShapeFactory1.AddNewPointOnPlane(reference16, ckq(4), ckq1(4))
hybridBody1.AppendHybridShape hybridShapePointOnPlane3
part1.InWorkObject = hybridShapePointOnPlane3
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference17 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane4
hybridShapeFactory1.AddNewPointOnPlane(reference17, ckq(6), ckq1(6))
hybridBody1.AppendHybridShape hybridShapePointOnPlane4
part1.InWorkObject = hybridShapePointOnPlane4
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference18 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane5
hybridShapeFactory1.AddNewPointOnPlane(reference18, ckq(8), ckq1(8))
hybridBody1.AppendHybridShape hybridShapePointOnPlane5
part1.InWorkObject = hybridShapePointOnPlane5
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference19 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
=
=
=
Set hybridShapePointOnPlane6
hybridShapeFactory1.AddNewPointOnPlane(reference19, ckq(10), ckq1(10))
hybridBody1.AppendHybridShape hybridShapePointOnPlane6
part1.InWorkObject = hybridShapePointOnPlane6
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference20 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane7
hybridShapeFactory1.AddNewPointOnPlane(reference20, ckq(12), ckq1(12))
hybridBody1.AppendHybridShape hybridShapePointOnPlane7
part1.InWorkObject = hybridShapePointOnPlane7
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference21 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane8
hybridShapeFactory1.AddNewPointOnPlane(reference21, ckq(14), ckq1(14))
hybridBody1.AppendHybridShape hybridShapePointOnPlane8
part1.InWorkObject = hybridShapePointOnPlane8
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference22 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane9
hybridShapeFactory1.AddNewPointOnPlane(reference22, ckq(16), ckq1(16))
hybridBody1.AppendHybridShape hybridShapePointOnPlane9
=
=
=
=
part1.InWorkObject = hybridShapePointOnPlane9
part1.Update
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference23 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapePointOnPlane10 = hybridShapeFactory1.AddNewPointOnPlane(reference23, ckq(18), ckq1(18))
hybridBody1.AppendHybridShape hybridShapePointOnPlane10
part1.InWorkObject = hybridShapePointOnPlane10
part1.Update
'绘制 spline 线
Set hybridShapeSpline1 = hybridShapeFactory1.AddNewSpline()
hybridShapeSpline1.SetSplineType 0
hybridShapeSpline1.SetClosing 0
Set reference24 = part1.CreateReferenceFromObject(hybridShapePointOnPlane1)
hybridShapeSpline1.AddPointWithConstraintExplicit reference24, Nothing, -1#, 1, Nothing, 0#
Set reference25 = part1.CreateReferenceFromObject(hybridShapePointOnPlane2)
hybridShapeSpline1.AddPointWithConstraintExplicit reference25, Nothing, -1#, 1, Nothing, 0#
Set reference26 = part1.CreateReferenceFromObject(hybridShapePointOnPlane3)
hybridShapeSpline1.AddPointWithConstraintExplicit reference26, Nothing, -1#, 1, Nothing, 0#
Set reference27 = part1.CreateReferenceFromObject(hybridShapePointOnPlane4)
hybridShapeSpline1.AddPointWithConstraintExplicit reference27, Nothing, -1#, 1, Nothing, 0#
Set reference28 = part1.CreateReferenceFromObject(hybridShapePointOnPlane5)
hybridShapeSpline1.AddPointWithConstraintExplicit reference28, Nothing, -1#, 1, Nothing, 0#
Set reference29 = part1.CreateReferenceFromObject(hybridShapePointOnPlane6)
hybridShapeSpline1.AddPointWithConstraintExplicit reference29, Nothing, -1#, 1, Nothing, 0#
Set reference30 = part1.CreateReferenceFromObject(hybridShapePointOnPlane7)
hybridShapeSpline1.AddPointWithConstraintExplicit reference30, Nothing, -1#, 1, Nothing, 0#
Set reference31 = part1.CreateReferenceFromObject(hybridShapePointOnPlane8)
hybridShapeSpline1.AddPointWithConstraintExplicit reference31, Nothing, -1#, 1, Nothing, 0#
Set reference32 = part1.CreateReferenceFromObject(hybridShapePointOnPlane9)
hybridShapeSpline1.AddPointWithConstraintExplicit reference32, Nothing, -1#, 1, Nothing, 0#
Set reference33 = part1.CreateReferenceFromObject(hybridShapePointOnPlane10)
hybridShapeSpline1.AddPointWithConstraintExplicit reference33, Nothing, -1#, 1, Nothing, 0#
hybridBody1.AppendHybridShape hybridShapeSpline1
part1.InWorkObject = hybridShapeSpline1
part1.Update
'绘制 spline 的延长线
Set reference34 = part1.CreateReferenceFromObject(hybridShapePointOnPlane1)
Set reference35 = part1.CreateReferenceFromObject(hybridShapeSpline1)
Set hybridShapeExtrapol1 = hybridShapeFactory1.AddNewExtrapolLength(reference34, reference35, Abs((length7.Value - length6.Value) * 1.5)) ' 改后的参数
hybridShapeExtrapol1.ContinuityType = 0
hybridShapeExtrapol1.BorderType = 1
hybridShapeExtrapol1.LimitType = 0
hybridShapeExtrapol1.SetAssemble True
hybridShapeExtrapol1.PropagationMode = 0
hybridShapeExtrapol1.ExtendEdgesMode = False
hybridShapeExtrapol1.ConstantLengthMode = False
hybridBody1.AppendHybridShape hybridShapeExtrapol1
part1.InWorkObject = hybridShapeExtrapol1
part1.Update
'延长线和齿根圆的 corner
part1.Update
Set reference36 = part1.CreateReferenceFromObject(hybridShapeExtrapol1)
Set reference37 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad4)
Set hybridShapeCorner1 = hybridShapeFactory1.AddNewCorner(reference36, reference37, Nothing, length15.Value, 1, 1, False)
hybridShapeCorner1.DiscriminationIndex = 1
hybridShapeCorner1.BeginOfCorner = 2
hybridShapeCorner1.FirstTangentOrientation = 1
hybridShapeCorner1.SecondTangentOrientation = 1
hybridShapeCorner1.TrimMode = 2
hybridShapeFactory1.GSMVisibility reference36, 0
hybridBody1.AppendHybridShape hybridShapeCorner1
part1.InWorkObject = hybridShapeCorner1
part1.Update
'本部分程序去除部分在新建txt里
Set reference38 = part1.CreateReferenceFromObject(hybridShapePointOnPlane1)
Set reference39 = part1.CreateReferenceFromObject(hybridShapeSpline1)
Set hybridShapeExtrapol1 = hybridShapeFactory1.AddNewExtrapolLength(reference38, reference39, 1.488473)
hybridShapeExtrapol1.ContinuityType = 0
hybridShapeExtrapol1.BorderType = 1
hybridShapeExtrapol1.LimitType = 0
hybridShapeExtrapol1.SetAssemble True
hybridShapeExtrapol1.PropagationMode = 0
hybridShapeExtrapol1.ExtendEdgesMode = False
hybridShapeExtrapol1.ConstantLengthMode = False
hybridBody1.AppendHybridShape hybridShapeExtrapol1
part1.InWorkObject = hybridShapeExtrapol1
part1.Update
Set reference40 = part1.CreateReferenceFromObject(hybridShapeCorner1)
Set reference41 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad2)
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference40, reference41)
hybridShapeIntersection1.PointType = 0
hybridBody1.AppendHybridShape hybridShapeIntersection1
part1.InWorkObject = hybridShapeIntersection1
part1.Update
'创建一条直线连接圆心和（分度圆与corner线交点）
Set reference42 = part1.CreateReferenceFromObject(hybridShapePointCoord2)
Set reference43 = part1.CreateReferenceFromObject(hybridShapeIntersection1)
Set hybridShapeLinePtPt1 = hybridShapeFactory1.AddNewLinePtPt(reference42,
reference43)
hybridBody1.AppendHybridShape hybridShapeLinePtPt1
part1.InWorkObject = hybridShapeLinePtPt1
part1.Update
'将上一步创建的直线按照第一步做的直线旋转
Set hybridShapeRotate1 = hybridShapeFactory1.AddNewEmptyRotate()
Set reference44 = part1.CreateReferenceFromObject(hybridShapeLinePtPt1)
hybridShapeRotate1.ElemToRotate = reference44
hybridShapeRotate1.VolumeResult = False
hybridShapeRotate1.RotationType = 0
Set reference45 = part1.CreateReferenceFromObject(hybridShapeLinePtDir1)
hybridShapeRotate1.Axis = reference45
hybridShapeRotate1.AngleValue = -90 / Val(txtCount.Text)
hybridBody1.AppendHybridShape hybridShapeRotate1
part1.InWorkObject = hybridShapeRotate1
part1.Update
'将corner进行对称操作
Set reference46 = part1.CreateReferenceFromObject(hybridShapeCorner1)
Set reference47 = part1.CreateReferenceFromObject(hybridShapeRotate1)
Set hybridShapeSymmetry1 = hybridShapeFactory1.AddNewSymmetry(reference46, reference47)
hybridShapeSymmetry1.VolumeResult = False
hybridBody1.AppendHybridShape hybridShapeSymmetry1
part1.InWorkObject = hybridShapeSymmetry1
part1.Update
'画一个比齿顶圆直径大5mm的圆以便进行裁剪操作
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePointCoord6 = hybridShapeFactory1.AddNewPointCoord(0#, 0#, 0#)
hybridBody1.AppendHybridShape hybridShapePointCoord6
part1.InWorkObject = hybridShapePointCoord6
part1.Update
Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord6)
Set originElements1 = part1.OriginElements
Set hybridShapePlaneExplicit1 = originElements1.PlaneXY
Set reference2 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1)
Set hybridShapeCircleCtrRad6 = hybridShapeFactory1.AddNewCircleCtrRad(reference1, reference2, False, length5.Value + 5)
hybridShapeCircleCtrRad6.DiameterMode = True
hybridShapeCircleCtrRad6.SetLimitation 1
hybridBody1.AppendHybridShape hybridShapeCircleCtrRad6
part1.InWorkObject = hybridShapeCircleCtrRad6
part1.Update
'裁剪出齿轮槽的连个弧线形状
Set reference49 = part1.CreateReferenceFromObject(hybridShapeSymmetry1)
Set reference50 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad6)
Set hybridShapeSplit1 = hybridShapeFactory1.AddNewHybridSplit(reference49, reference50, 1)
hybridShapeFactory1.GSMVisibility reference49, 0
hybridBody1.AppendHybridShape hybridShapeSplit1
part1.InWorkObject = hybridShapeSplit1
part1.Update
Set reference51 = part1.CreateReferenceFromObject(hybridShapeCorner1)
Set reference52 = part1.CreateReferenceFromObject(hybridShapeCircleCtrRad6)
Set hybridShapeSplit2 = hybridShapeFactory1.AddNewHybridSplit(reference51, reference52, 1)
hybridShapeFactory1.GSMVisibility reference51, 0
hybridBody1.AppendHybridShape hybridShapeSplit2
part1.InWorkObject = hybridShapeSplit2
part1.Update
'画两条连接弧线的直线并进行assembly操作
Set reference53 = part1.CreateReferenceFromBRepName(\Corner.1;1)));None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)\
Set reference54 = part1.CreateReferenceFromBRepName(\s1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)\
Set hybridShapeLinePtPt2 = hybridShapeFactory1.AddNewLinePtPt(reference53, reference54)
hybridBody1.AppendHybridShape hybridShapeLinePtPt2
part1.InWorkObject = hybridShapeLinePtPt2
part1.Update
Set reference55 = part1.CreateReferenceFromBRepName(\etry.1;(Brp:(GSMCurve.1)));Brp:(GSMCircle.6)));None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)\hybridShapeSplit1)
Set reference56 = part1.CreateReferenceFromBRepName(\.1);Brp:(GSMCircle.6)));None:(Limits1:();Limits2:();-1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)\
Set hybridShapeLinePtPt3 = hybridShapeFactory1.AddNewLinePtPt(reference55, reference56)
hybridBody1.AppendHybridShape hybridShapeLinePtPt3
part1.InWorkObject = hybridShapeLinePtPt3
part1.Update
Set reference57 = part1.CreateReferenceFromObject(hybridShapeLinePtPt3)
Set reference58 = part1.CreateReferenceFromObject(hybridShapeSplit1)
Set hybridShapeAssemble1 = hybridShapeFactory1.AddNewJoin(reference57, reference58)
Set reference59 = part1.CreateReferenceFromObject(hybridShapeLinePtPt2)
hybridShapeAssemble1.AddElement reference59
Set reference60 = part1.CreateReferenceFromObject(hybridShapeSplit2)
hybridShapeAssemble1.AddElement reference60
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 hybridShapeDirection1 = hybridShapeFactory1.AddNewDirectionByCoord(0#, 0#, 1#)
Set hybridShapeTranslate1 = hybridShapeFactory1.AddNewEmptyTranslate()
Set reference61 = part1.CreateReferenceFromObject(hybridShapeAssemble1)
hybridShapeTranslate1.ElemToTranslate = reference61
hybridShapeTranslate1.VectorType = 0
hybridShapeTranslate1.Direction = hybridShapeDirection1
hybridShapeTranslate1.DistanceValue = Val(txtDis.Text)
hybridShapeTranslate1.VolumeResult = False
hybridBody1.AppendHybridShape hybridShapeTranslate1
part1.InWorkObject = hybridShapeTranslate1
part1.Update
'旋转操作
Set hybridShapeRotate2 = hybridShapeFactory1.AddNewEmptyRotate()
Set reference62 = part1.CreateReferenceFromObject(hybridShapeTranslate1)
hybridShapeRotate2.ElemToRotate = reference62
hybridShapeRotate2.VolumeResult = False
hybridShapeRotate2.RotationType = 0
Set reference63 = part1.CreateReferenceFromObject(hybridShapeLinePtDir1)
hybridShapeRotate2.Axis = reference63
hybridShapeRotate2.AngleValue = angle2.Value
hybridBody1.AppendHybridShape hybridShapeRotate2
part1.InWorkObject = hybridShapeRotate2
part1.Update
'进行loft操作绘制成一个齿轮槽实体
part1.InWorkObject = body2
Set shapeFactory1 = part1.ShapeFactory
Set loft1 = shapeFactory1.AddNewLoft()
Set hybridShapeLoft1 = loft1.HybridShape
hybridShapeLoft1.SectionCoupling = 3
hybridShapeLoft1.Relimitation = 1
hybridShapeLoft1.CanonicalDetection = 2
Set hybridBodies1 = part1.HybridBodies
Set hybridBody1 = hybridBodies1.Item(\
Set hybridShapes1 = hybridBody1.HybridShapes
Set hybridShapeRotate2 = hybridShapes1.Item(\
Set reference64 = part1.CreateReferenceFromObject(hybridShapeRotate2)
Set reference65 = part1.CreateReferenceFromBRepName(\.2;(Brp:(GSMTranslate.1;(Brp:(GSMSymmetry.1;(Brp:(GSMCurve.1)))))));None:();Cf11:());Face:(Brp:(GSMRotate.2;(Brp:(GSMTranslate.1;(Brp:(GSMLine.4)))));None:();Cf11:()));Cf11:());WithPermanentBody;WithoutBuildError;WithInitialFeatureSupport;MFBRepVersion_CXR15)\hybridShapeRotate2)
hybridShapeLoft1.AddSectionToLoft reference64, 1, reference65
Set hybridShapeAssemble1 = hybridShapes1.Item(\
Set reference66 = part1.CreateReferenceFromObject(hybridShapeAssemble1)
Set reference67 = part1.CreateReferenceFromBRepName(\etry.1;(Brp:(GSMCurve.1)));None:();Cf11:());Face:(Brp:(GSMLine.4);None:();Cf11:()));Cf11:());WithPermanentBody;WithoutBuildError;WithInitialFeatureSupport;MFBRepVersion_CXR15)\hybridShapeAssemble1)
hybridShapeLoft1.AddSectionToLoft reference66, 1, reference67
part1.InWorkObject = hybridShapeLoft1
part1.Update
'对上一步绘制好的齿轮槽进行圆周阵列
Set reference68 = part1.CreateReferenceFromName(\
Set reference69 = part1.CreateReferenceFromName(\
Set circPattern1 = shapeFactory1.AddNewCircPattern(Nothing, 1, 2, 20#, 45#, 1, 1, reference68, reference69, True, 0#, True)
circPattern1.CircularPatternParameters = catInstancesandAngularSpacing
Set relations18 = part1.Relations
Set angularRepartition1 = circPattern1.AngularRepartition
Set intParam1 = angularRepartition1.InstancesCount
Set formula16 = relations18.CreateFormula(\齿轮齿数z` \
formula16.Rename \
Set relations19 = part1.Relations
Set angularRepartition2 = circPattern1.AngularRepartition
Set angle4 = angularRepartition2.AngularSpacing
Set formula17 = relations19.CreateFormula(\齿轮齿数z`
\
formula17.Rename \
Set reference70 = part1.CreateReferenceFromObject(hybridShapeLinePtDir1)
circPattern1.SetRotationAxis reference70
part1.UpdateObject circPattern1
part1.Update
'进行remove操作生成齿轮实体
Set selection2 = partDocument1.Selection
Set visPropertySet2 = selection2.VisProperties
Set bodies1 = body1.Parent
Dim bSTR4
bSTR4 = body1.Name
selection2.Add body1
Set visPropertySet2 = visPropertySet2.Parent
Dim bSTR5
bSTR5 = visPropertySet2.Name
Dim bSTR6
bSTR6 = visPropertySet2.Name
visPropertySet2.SetShow 0
selection2.Clear
part1.InWorkObject = body1
Set remove1 = shapeFactory1.AddNewRemove(body2)
part1.UpdateObject remove1
part1.Update
End Sub
Private Sub Command1_Click() End End Sub
Private Sub Form_Load()
cmdCreate.Enabled = False End Sub
Private Sub Timer1_Timer()
Label5.Caption = \现在时间为\End Sub
Private Sub txtDis_Change() cmdCreate.Enabled = True End Sub