为何这个程序会运行不了了呢？（求助）
这是一个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
发现以下错误
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这两点坐标相同而出错。
自己改改再来吧
谢谢了！呵呵
页:
[1]