catia二次开发程序

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

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

本文来源：https://www.bwwdw.com/article/zn5r.html