为何这个程序会运行不了了呢？（求助）

lcj68

这是一个3维动画程序。在不同的窗体内分开运行可以，但是一到组成一个整体就不能运行，不知道是什么地方出了问题！万望解答！我在声明段中加入了：Dim donghua As AcadApplication，程序已连接上了AutoCAD
具体程序如下：  
On Error Resume Next
    Dim wd As Double
    Dim wg As Double
    Dim wf As Double
    Dim wm As Double
    Dim wk As Double
    wm = 8
    wf = 80
    wk = 100
    '蜗轮毛坏
    wd = wf + 2 * wm '蜗杆顶圆直径
    wg = wf - 2.4 * wm '蜗杆低圆直径
   
    Dim 蜗杆3d As Acad3DSolid
    Dim centerpoint(0 To 2) As Double
    centerpoint(0) = 0#: centerpoint(1) = 0#: centerpoint(2) = 0#
    'wk为蜗杆的高度，以定义
    Set 蜗杆3d = donghua.ActiveDocument.ModelSpace.AddCylinder(centerpoint, wd / 2, wk)
    '旋转毛坏，沿x轴转90度
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    Dim angle As Double
    point1(0) = 2: point1(1) = 0: point1(2) = 0
    point2(0) = -2: point2(1) = 0: point2(2) = 0
    angle = 1.57 '90*3.14/180，弧度
    蜗杆3d.Rotate3D point1, point2, angle
    ZoomAll
    '转换视点
Dim newdirection(0 To 2) As Double
newdirection(0) = 1: newdirection(1) = 0.5: newdirection(2) = 0.5

cad.ActiveDocument.ActiveViewport.Direction = newdirection
cad.ActiveDocument.ActiveViewport = donghua.ActiveDocument.ActiveViewport
cad.ActiveDocument.SendCommand "_shademode" + vbCr + "_g" + vbCr

'拉伸cad
'由于ZA型蜗杆轴向压力角为20度，得蜗杆齿高
Dim thdg As Double
Dim th1 As Double
Dim th2 As Double
thdg = (wd - wg) / 2
th1 = wm * 3.14159 / 4 - (wf - wd) * Tan(20) / 2
th2 = wm * 3.14159 / 2 + 0.72794 * wm

Dim curves(1) As AcadLWPolyline
Dim points(0 To 9) As Double

points(0) = wg / 2: points(1) = 0 '第1点
points(2) = wg / 2: points(3) = th1 '第2点
points(4) = wd / 2: points(5) = th2 '第3点
points(6) = wd / 2 + wm: points(7) = th2 '第4点
points(8) = wd / 2 + wm: points(9) = 0 '第5点

'创建刀具右部线段
Set curves(0) = donghua.ActiveDocument.ModelSpace.AddLightWeightPolyline(points)
'curves(0).SetBulge 1, -0.3

Dim point11(0 To 2) As Double
Dim point12(0 To 2) As Double
point11(0) = -2: point11(1) = 0: point11(2) = 0
point12(0) = 2: point12(1) = 0: point12(2) = 0
'镜像刀具右部线段，得到左部线段
Set curves(1) = curves(0).Mirror(point11, point12)
'创建刀具面域
Dim 刀具 As Variant
刀具 = donghua.ActiveDocument.ModelSpace.AddRegion(curves)
'拉伸刀具（面域）得到三维刀具实体
Dim height As Double
Dim angle1 As Double
height = 3
angle1 = 0 '弧度
'创建面域拉伸实体
Dim 刀具1 As Acad3DSolid
Set 刀具1 = donghua.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), height, angle1)
               
ZoomAll
'动画制作
Dim d
Dim x As Integer
Dim point13(2) As Double
Dim point14(2) As Double
Dim angle2 As Double
point13(0) = 0: point13(1) = 0: point1(32) = 0
point14(0) = 0: point14(1) = 8: point14(2) = 0
angle2 = 45 * 3.14 / 180
i = 0
Do Until d > 5 'wd
Dim point15(2) As Double
Dim point16(2) As Double
point15(0) = 0: point15(1) = d - 1: point15(2) = 0
point16(0) = 0: point16(1) = d + 9: point16(2) = 0 '刀具移动多少未知，故先取10mm
  For i = 0 To 360 Step 45
    '蜗杆旋转（每次旋45度）
    蜗杆3d.Rotate3D point13, point15, angle2
    蜗杆3d.Update
Next i
    '刀具复制
    Dim 刀具复制 As Acad3DSolid
    Set 刀具复制 = 刀具1.Copy
    刀具复制.Update
    '蜗杆与刀具求差集
    蜗杆3d.Boolean acSubtraction, 刀具1
    '刀具移动
    刀具复制.Move point15, point16
    刀具1 = 刀具复制
    '删除除“蜗杆3d，刀具1”以外的所有实体
    Dim del As AcadEntity
    '对模型空间的每一个成员作一次抵换
    For Each del In donghua.ActiveDocument.modelspale
        If del.ObjectID <> 蜗杆3d.ObjectID And del.ObjectID <> 刀具1.ObjectID Then del.Delete
    Next
    蜗杆3d.Color = acGreen
    蜗杆3d.Update
    ZoomAll
d = d + 1 '(运行4次)
Loop

mccad

1.
point13(0) = 0: point13(1) = 0: point1(32) = 0
应改为
point13(0) = 0: point13(1) = 0: point1(2) = 0

2.
    刀具1 = 刀具复制
应改为：
   Set 刀具1 = 刀具复制

3.
    For Each del In donghua.ActiveDocument.modelspale
单词拼写有错

4.循环时由于d值改变，造成point13, point15这两点坐标相同而出错。

自己改改再来吧

lcj68