希望有大神能够帮我修改下VBA程序

爱鑫怡爱生活

新手小白，为完成课程设计。边看书，边做。为实现自动生成一对斜齿轮，只要出图就行。
思路是先画一个轮齿的齿廓，然后阵列，然后拉伸成为一个实体。
错误可能有点多，望谅解~真心求助。

Private Sub userform1_load()
Me.Left = (Screen.width_me.Width)
Me.top = 0
Me.TextBox7 .Text = 31
Me.TextBox8.Text = 63.91
Me.TextBox9.Text = 67.91
Me.TextBox10.Text = 58.91
Me.TextBox11.Text = 69
Me.TextBox17.Text = 60.91

Me.TextBox12.Text = 99
Me.TextBox13.Text = 204.09
Me.TextBox14.Text = 208.09
Me.TextBox15.Text = 199.09
Me.TextBox16.Text = 64
Me.TextBox18.Text = 202.09

Me.CommandButton1.Caption = "开始"
Me.CommandButton2.Caption = "结束"


Dim z1, d1, da1, df1, db1, b1, ε, θ, α, μ, η As Double
End Sub

Private Sub CommandButton1_Click()
On Error Resume Next
AcadApp.ActiveDocument.Close
AcadApp.Documents.Add

'创建小齿轮
'------------------------------------------------------------
Dim circleObj As AcadCircle
Dim centerpoint(0 To 2) As Double
Dim radius As Double
'定义圆心坐标跟半径
centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#
radius = 30.45
'创建圆
Set circleObj = AcadApp.ActiveDocument.ModelSpace.addcircle_(centerpoint, radius)
ZoomAll
'-------------------------------------------------------------

z1 = Me.TextBox7
d1 = Me.TextBox8
da1 = Me.TextBox9
df1 = Me.TextBox10
db1 = Me.TextBox17
b1 = Me.TextBox11

ε = (Sqr((df1) ^ 2 - (db1) ^ 2)) / db1
θ = (Sqr((d1) ^ 2 - (db1) ^ 2)) / db1
α = (Sqr((da1) ^ 2 - (db1) ^ 2)) / db1
μ = ε + (θ - ε) / 2
η = θ + (α - θ) / 2

'连接点P1，P2
Dim lineObj0 As AcadLine
Dim p1(0 To 1) As Double
Dim P2(0 To 1) As Double
'定义直线的起点与终点的二维坐标
p1(0) = db1 / 2#: p1(1) = 0#
P2(0) = db1 * (cosε + ε * sinε) / 2#: P2(1) = db1 * (sinε - ε * cosε) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(p1, P2)
ZoomAll

'连接点P2,P3
Dim lineObj1 As AcadLine

Dim P3(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P2(0) = db1 * (cosε + ε * sinε) / 2#: P2(1) = db1 * (sinε - ε * cosε) / 2#
P3(0) = db1 * (cosμ + μ * sinμ) / 2#: P3(1) = db1 * (sinμ - μ * cosμ) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P2, P3)
ZoomAll

'连接点P3,P4
Dim lineObj2 As AcadLine

Dim P4(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P3(0) = db1 * (cosμ + μ * sinμ) / 2#: P3(1) = db1 * (sinμ - μ * cosμ) / 2#
P4(0) = db1 * (cosθ + θ * sinθ) / 2#: P4(1) = db1 * (sinθ - θ * cosθ) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P3, P4)
ZoomAll

'连接点P4,P5
Dim lineObj3 As AcadLine

Dim P5(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P4(0) = db1 * (cosθ + θ * sinθ) / 2#: P4(1) = db1 * (sinθ - θ * cosθ) / 2#
P5(0) = db1 * (cosη + η * sinη) / 2#: P3(1) = db1 * (sinη - η * cosη) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P4, P5)
ZoomAll

'连接点P5,P6
Dim lineObj4 As AcadLine

Dim P6(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P5(0) = db1 * (cosη + η * sinη) / 2#: P3(1) = db1 * (sinη - η * cosη) / 2#
P6(0) = db1 * (cosα + α * sinα) / 2#: P4(1) = db1 * (sinα - α * cosα) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P5, P6)
ZoomAll





λ = π / 2 * z1
γ = Atn((db1 * (sinθ - θ * cosθ) / 2) / (db1 * (cosθ + θ * sinθ) / 2))
δ = λ + γ

'连接点P6,P7
Dim lineObj5 As AcadLine

Dim P7(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P6(0) = db1 * (cosα + α * sinα) / 2#: P4(1) = db1 * (sinα - α * cosα) / 2#
P7(0) = da1 * cosδ / 2: P7(1) = da1 * sinδ / 2
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P6, P7)
ZoomAll


Dim mirrorPt1(0 To 1) As Double
Dim mirrorPt2(0 To 2) As Double

mirrorPt1(0) = 0#: mirrorPt1(1) = 0#
mirrorPt2(0) = da1 * cosδ / 2#: mirrorPt2(1) = da1 * sinδ / 2

'镜像P1到P7的连线
Dim mirrorlineObj As AcadLine
Set mirrorlineObj = lineObj.Mirror(mirrorPt1, morrorPt2)



'------------------------------------------------------------------
'阵列轮齿齿廓
Dim boxObj As AcadSolid
Dim center(0 To 1) As Double
Dim taperAngle As Double
taperAngle = 0
center(0) = 0#: center(1) = 0#
Set boxObj = Userfrom1.ActiveDocument.ModelSpace.AddBox_(center, (Pi * m) / 2, 4 * m)

Dim retObj As Variant
retObj = boxObj.ArrayPolar(31, 2 * Pi, center)
For I = 0 To 32 - 2 '齿轮齿数为31
    retObj(I).Rotate center, centerpoint, 3.14 / 2
    retObj(I).Update

Next I


'齿廓形成面域
Dim boxObj1 As AcadEntity
Dim regionObj As Variant
regionObj = AcadApp.ActiveDocument.ModelSpace.AddRegion(boxObj)

'定义拉伸
Dim height As Double
Dim taperAngle1 As Double
height = 69
taperAngle = 14.032

'创建面域拉伸实体
Dim solidObj1 As Acad3DSolid
Set solidObj1 = AcadApp.ActiveDocument.ModelSpace.AddExtrudedsolid_(regionObj, height, taperAngle)





'创建大齿轮模型
'-----------------------------------------------------------
Dim ucsObj As AcadUCS
Dim origin(0 To 1) As Double
Dim xAxisPoint(0 To 1) As Double
Dim yAxisPoint(0 To 1) As Double
origin(0) = 0: origin(1) = 0
xAxisPoint(0) = 134: xAxisPoint(1) = 0
yAxisPoint(0) = 0: yAxisPoint(1) = 0
Set ucsObj = AcadApp.ActiveDocument.UserCoordinateSystems.Add_(origin, xAxisPoint, yAxisPoint, "UCS1")
AcadApp.ActiveDocument.ActiveUCS = ucsObj

'显示UCS图标
AcadApp.ActiveDocument.ActiveViewport.UCSIconOn = True
AcadApp.ActiveDocument.ActiveViewport.UCSIconAtOrigin = True



Dim circleObj1 As AcadCircle
Dim centerpoint1(0 To 2) As Double
Dim radius1 As Double
'定义圆心坐标跟半径
centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#
radius = 101.045
'创建圆
Set circleObj = AcadApp.ActiveDocument.ModelSpace.addcircle_(centerpoint, radius)
ZoomAll
'-------------------------------------------------------------
Dim z2, d2, da2, df2, db2, b2
z2 = Me.TextBox12
d2 = Me.TextBox13
da2 = Me.TextBox14
df2 = Me.TextBox15
db2 = Me.TextBox18
b2 = Me.TextBox16

ε = (((df2) ^ 2 - (db2) ^ 2) ^ -2) / db2
θ = (((d2) ^ 2 - (db2) ^ 2) ^ -2) / db2
α = (((da2) ^ 2 - (db2) ^ 2) ^ -2) / db2
μ = ε + (θ - ε) / 2
η = θ + (α - θ) / 2

'连接点P1，P2
Dim line0 As AcadLine
Dim H1(0 To 1) As Double
Dim H2(0 To 1) As Double
'定义直线的起点与终点的二维坐标
p1(0) = db2 / 2#: p1(1) = 0#
P2(0) = db2 * (cosε + ε * sinε) / 2#: P2(1) = db2 * (sinε - ε * cosε) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(p1, P2)
ZoomAll

'连接点P2,P3
Dim line1 As AcadLine

Dim H3(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P2(0) = db2 * (cosε + ε * sinε) / 2#: P2(1) = db2 * (sinε - ε * cosε) / 2#
P3(0) = db2 * (cosμ + μ * sinμ) / 2#: P3(1) = db2 * (sinμ - μ * cosμ) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P2, P3)
ZoomAll

'连接点P3,P4
Dim line2 As AcadLine

Dim H4(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P3(0) = db2 * (cosμ + μ * sinμ) / 2#: P3(1) = db2 * (sinμ - μ * cosμ) / 2#
P4(0) = db2 * (cosθ + θ * sinθ) / 2#: P4(1) = db2 * (sinθ - θ * cosθ) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P3, P4)
ZoomAll

'连接点P4,P5
Dim line3 As AcadLine

Dim H5(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P4(0) = db * (cosθ + θ * sinθ) / 2#: P4(1) = db * (sinθ - θ * cosθ) / 2#
P5(0) = db * (cosη + η * sinη) / 2#: P3(1) = db * (sinη - η * cosη) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P4, P5)
ZoomAll

'连接点P5,P6
Dim line4 As AcadLine

Dim H6(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P5(0) = db2 * (cosη + η * sinη) / 2#: P3(1) = db2 * (sinη - η * cosη) / 2#
P6(0) = db2 * (cosα + α * sinα) / 2#: P4(1) = db2 * (sinα - α * cosα) / 2#
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P5, P6)
ZoomAll


λ = π / 2 * z1
γ = Atn((db2 * (sinθ - θ * cosθ) / 2) / (db2 * (cosθ + θ * sinθ) / 2))
δ = λ + γ

'连接点P6,P7
Dim line5 As AcadLine

Dim H7(0 To 1) As Double
'定义直线的起点与终点的二维坐标
P6(0) = db2 * (cosα + α * sinα) / 2#: P4(1) = db2 * (sinα - α * cosα) / 2#
P7(0) = da2 * cosδ / 2: P7(1) = da2 * sinδ / 2
Set lineObj = AcadApp.activedocumentmodelspace.appline_(P6, P7)
ZoomAll


Dim mirrorH1(0 To 1) As Double
Dim mirrorH2(0 To 2) As Double

mirrorPt1(0) = 0#: mirrorPt1(1) = 0#
mirrorPt2(0) = da2 * cosδ / 2#: mirrorPt2(1) = da2 * sinδ / 2

'镜像P1到P7的连线
Dim mirrorline As AcadLine
Set mirrorline = lineObj.Mirror(mirrorPt1, morrorPt2)



'------------------------------------------------------------------
'阵列轮齿齿廓
Dim box2 As AcadSolid
Dim center1(0 To 1) As Double
Dim taperAngle2 As Double
taperAngle = 0
center1(0) = 0#: center1(1) = 0#
Set box2 = Userfrom1.ActiceDocument.ModelSpace.AddBox_(center, m / 2, 4 * m)
Dim retObj1 As Variant
retObj = box2.ArrayPolar(31, 2 * Pi, center1)
For I = 0 To 32 - 2 '齿轮齿数为31
    retObj(I).Rotate center1, centerpoint, 3.14 / 2
    retObj(I).Update

Next I


'齿廓形成面域
Dim box2Obj As AcadEntity
Dim regionObj1 As Variant
regionObj = AcadApp.ActiveDocument.ModelSpace.AddRegion(box2)

'定义拉伸
Dim height1 As Double
Dim taper1Angle As Double
height = 64
taperAngle = -14.032

'创建面域拉伸实体
Dim solidObj2 As Acad3DSolid
Set solidObj2 = AcadApp.ActiveDocument.ModelSpace.AddExtrudedsolid_(regionObj, height, taperAngle)



End Sub


Private Sub CommandButton2_Click()
End
End Sub




该贴已经同步到 爱鑫怡爱生活的微博

zzyong00

你把vba文件发上来，不然窗体中哪么控件，添加也很麻烦！
这么多代码，不调试很难知道哪错了

爱鑫怡爱生活

zzyong00 发表于 2015-1-24 19:20
你把vba文件发上来，不然窗体中哪么控件，添加也很麻烦！
这么多代码，不调试很难知道哪错了

附件已上，今天又修改了一下。感觉还是很多不对的地方，求指教，谢谢了

zzyong00

楼主，几点建议
1、开明白vb语法中的数据类型，z1 = Me.TextBox7，z1得到的是字符串，不能进行数学运算，
改为z1 = Val(Me.TextBox7)，这样的代码很多！
2、ε = (((df2) ^ 2 - (db2) ^ 2) ^ -2) / db2,这么多括号是干吗的？你要搞明白vb的运算优先级！这完全可能改为：ε = Sqr(df1 ^ 2 - db1 ^ 2) / db1
3、ε = Sqr(df1 ^ 2 - db1 ^ 2) / db1，既然要开平方，必须保证df1 ^ 2 - db1 ^ 2是正数！你给你例子得出结果是负数！
4、Dim p1(0 To 1) As Double
Dim P2(0 To 1) As Double
....
Call ThisDrawing.ModelSpace.AddLine(p1, P2)
vba帮助内容
RetVal = object.AddLine(StartPoint, EndPoint)
ModelSpace 集合, PaperSpace 集合, Block
使用该方法的对象。

StartPoint

Variant[变体] (三元素双精度数组); 仅用于输入
指定直线起点的三维WCS坐标。

EndPoint

Variant[变体] (三元素双精度数组); 仅用于输入
指定直线终点的三维WCS坐标。
StartPoint，EndPoint都是三维点，你定义成了二维点。。
5、Public AcadApp As AcadApplication '定义了AcadApp 对象，但是从来没有对它进行实例化，也就是AcadApp 没有指向一个真正的对象，而后面直接用：
AcadApp.ActiveDocument.CloseAcadApp.Documents.Add

当然出错了！
这里可以用：Set AcadApp = ThisDrawing.Application 实例化



后面的没细看，你还是改改吧，尤其是vb的基础，一定要弄明白，还有一些编码的规则也学学，如变量的明确定义，变量的命令规则等

爱鑫怡爱生活

zzyong00 发表于 2015-1-25 14:57
楼主，几点建议
1、开明白vb语法中的数据类型，z1 = Me.TextBox7，z1得到的是字符串，不能进行数学运算，
...

感谢大神悉心指导，做课程设计太赶了，没那么多时间看书，慢慢的才了解一点点了。
非常感谢！

爱鑫怡爱生活

zzyong00 发表于 2015-1-25 14:57
楼主，几点建议
1、开明白vb语法中的数据类型，z1 = Me.TextBox7，z1得到的是字符串，不能进行数学运算，
...

大神，能够留个QQ吗？还有很多想要请教你，麻烦你了。