高手帮忙解决我的齿轮二次开发程序问题。。。

HideWong

我做的这个齿轮二次开发程序，老师要求做成三维的。

现在我的二维图已经初具雏形。但是在面域的生成上卡壳了，实在不知道该怎么去生成面域，请各位高手指点一下。

还有就是，我做的这个程序当齿数大于35的时候，画出来的齿轮就乱七八糟，我不知道该怎么改进，也请各位帮忙了。

主要的程序如下：

Private Sub CommandButton1_Click()
Dim m As Double, z As Double, b As Double, afa As Double, c As Double
Dim ha As Double
Dim Center(0 To 2) As Double
Dim Ra As Double, R As Double, Rf As Double, Rb As Double
m = Val(TextBox1.Text)
z = Val(TextBox2.Text)
afa = Val(TextBox3.Text)
ha = Val(TextBox4.Text)
c = Val(TextBox5.Text)
b = Val(TextBox6.Text)
Center(0) = 0
Center(1) = 0
Center(2) = 0
afa = afa * (Atn(1) * 4) / 180
R = m * z / 2
Rf = (R - (ha + c) * m)
Rb = R * Cos(afa)
Ra = (z + 2 * ha) * m / 2
Dim lunchiObj As AcadBlock
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
Set lunchiObj = ThisDrawing.Blocks.Add(insertionPnt, "curves")
  
Dim Sb As Double
Dim Th(0 To 3) As Double
Sb = Cos(afa) * (3.14 * m / 2 + m * z * (Tan(afa) - (afa)))
Th(1) = Sb / (2 * Rb)
Th(0) = Th(1) / 3
Th(3) = Th(1) - Tan(Acos(Rb / Ra)) + Acos(Rb / Ra)
Th(2) = Th(1) - Tan(afa) + afa
Dim curves(0 To 7) As AcadEntity
Dim Points0(0 To 5) As Double
Dim Points1(0 To 8) As Double
Dim Points2(0 To 5) As Double
Points0(0) = 0: Points0(1) = Ra
Points0(2) = Points0(0): Points0(3) = Points0(1)
Points0(4) = Ra * Sin(Th(3)): Points0(5) = Ra * Cos(Th(3))
Dim sTan(0 To 2) As Double
Dim eTan(0 To 2) As Double
sTan(0) = 0: sTan(1) = 0: sTan(2) = 0
eTan(0) = 0: eTan(1) = 0: eTan(2) = 0
Points1(0) = Points0(4): Points1(1) = Points0(5): Points1(2) = 0
Points1(3) = R * Sin(Th(2)): Points1(4) = R * Cos(Th(2)): Points1(5) = 0
Points1(6) = Rb * Sin(Th(1)): Points1(7) = Rb * Cos(Th(1)): Points1(8) = 0
'''''''''''''''''''''''''''''''''''''''''''''''''''
Points2(0) = Points1(6): Points2(1) = Points1(7)
Points2(2) = Rf * Sin(Th(1) + Th(0)): Points2(3) = Rf * Cos(Th(1) + Th(0))
Points2(4) = Points2(2): Points2(5) = Points2(3)
If Rb < Rf Then
Points1(6) = R * Sin(Th(2)) * 0.7: Points1(7) = Rf + 0.25 * m * 0.8: Points1(8) = 0
Points2(0) = Points1(6): Points2(1) = Points1(7)
Points2(2) = R * Sin(Th(2)) * 0.2: Points2(3) = Rf + 0.25 * m * 0.03: Points1(2) = 0
End If
Set curves(0) = lunchiObj.AddLightWeightPolyline(Points0)
curves(0).Update
Set curves(1) = lunchiObj.AddSpline(Points1, sTan, eTan)
curves(1).Update
Set curves(2) = lunchiObj.AddLightWeightPolyline(Points2)
curves(2).SetBulge 1, 0.2
curves(2).Update
Dim sAn As Double, eAn As Double
eAn = Atn(1) * 2 - (Th(0) + Th(1))
sAn = Atn(1) * 2 - Atn(1) * 8 / (2 * z)
Set curves(3) = lunchiObj.AddArc(Center, Rf, sAn, eAn)
curves(3).Update
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 0: point1(1) = 0: point1(2) = 0
point1(0) = 0: point1(1) = 1: point1(2) = 0
Set curves(4) = curves(0).Mirror(point1, point2)
Set curves(5) = curves(1).Mirror(point1, point2)
Set curves(6) = curves(2).Mirror(point1, point2)
Set curves(7) = curves(3).Mirror(point1, point2)
Dim blockRefObj As AcadBlockReference
insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "curves", 1, 1, 1, 0)
Dim retObj As Variant
Dim basePnt(0 To 2) As Double
'basePnt(0) = 0#: basePnt(1) = 0#: basePnt(2) = 0#
retObj = blockRefObj.ArrayPolar(z, Atn(1) * 8, Center)
ZoomAll
ThisDrawing.Regen acAllViewports
Unload Me
End Sub

HideWong

linedown

我的问题跟你一样呢，我也不知道怎样生成面域呢。

HideWong

我的邮箱：wangpeng1305@163.com

希望高手来给帮忙啊！！