明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1868|回复: 2

为何这个程序会运行不了了呢?(求助)

[复制链接]
发表于 2003-5-3 16:48 | 显示全部楼层 |阅读模式
这是一个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
发表于 2003-5-3 17:14 | 显示全部楼层

发现以下错误

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这两点坐标相同而出错。

自己改改再来吧
 楼主| 发表于 2003-5-3 19:49 | 显示全部楼层

谢谢了!呵呵

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 00:00 , Processed in 0.225465 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表