请各位大虾帮忙看看这个程序哪里错在哪里 急~~~

120010139

小弟初学VBA不久,最近做了一个练习.这个程序的目的可以实现CAD图中实体变成三视图 但小弟在运行过程中老是出错,请各位大虾帮帮忙!!谢谢了!!!! Sub 三视图显示() '俯视显示视图
ThisDrawing.SendCommand ("_-view" + vbCr + "_top" + vbCr) '找出图中齿轮实体
Dim returnObj As Object
Dim Obj3D As Boolean For Each returnObj In ThisDrawing.ModelSpace
If returnObj.ObjectName = "AcDb3dsolid" Then
Obj3D = True
Exit For
End If
Next '若图中无齿轮实体，退出过程
If Obj3D = False Then
MsgBox "图中无齿轮实体", vbOKOnly, "重要提示!"
Exit Sub
End If '获取包含实体外框的最大、最小点坐标
Dim minExt As Variant
Dim maxExt As Variant returnObj.GetBoundingBox minExt, maxExt '将齿轮实体复制3份
Dim returnObjLeft As Object '左视图
Dim returnObjTop As Object '俯视图
Dim returnObjSouthWest As Object '轴测视图 Set returnObjLeft = returnObj.Copy
Set returnObjTop = returnObj.Copy
Set returnObjSouthWest = returnObj.Copy '生成左视图
Dim pt1(2), pt2(2) As Double
pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0): pt2(1) = pt1(1) + 1: pt2(2) = pt1(2) '旋转90度得左视图
returnObjLeft.Rotate3D pt1, pt2, 3.1415 / 2 Dim ScaleD As Double '放大视图间的距离
ScaleD = 1.2 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + (maxExt(0) - minExt(0)) * ScaleD: pt2(1) = pt1(1): pt2(2) = pt1(2) '向右移动左视图
returnObjLeft.Move pt1, pt2 '生成俯视图
pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + 1: pt2(1) = pt1(1): pt2(2) = pt1(2) '旋转90度得俯视图
returnObjTop.Rotate3D pt1, pt2, 3.1415 / 2 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0): pt2(1) = pt1(1) - (maxExt(0) - minExt(0)) * ScaleD: pt2(2) = pt1(2) '向下移动俯视图
returnObjTop.Move pt1, pt2 '生成轴测视图
pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + 1: pt2(1) = pt1(1): pt2(2) = pt1(2) '旋转45度
returnObjSouthWest.Rotate3D pt1, pt2, -3.1415 / 4 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0): pt2(1) = pt1(1) + 1: pt2(2) = pt1(2) '旋转45度
returnObjSouthWest.Rotate3D pt1, pt2, -3.1415 / 4 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + (maxExt(0) - minExt(0)) * ScaleD: pt2(1) = pt1(1) - (maxExt(1) - _
minExt(1)) * ScaleD: pt2(2) = pt1(2) '向右下移动轴测视图
returnObjSouthWest.Move pt1, pt2 '三点定义左视图的剖切平面
Dim slicePt1(2) As Double
Dim slicePt2(2) As Double
Dim slicePt3(2) As Double slicePt1(0) = (minExt(0) + maxExt(0)) / 2: slicePt1(1) = (minExt(1) + maxExt(1)) / 2: _
slicePt1(2) = (minExt(2) + maxExt(2)) / 2
slicePt2(0) = slicePt1(0): slicePt2(1) = slicePt1(1) + 1: slicePt2(2) = slicePt1(2)
slicePt3(0) = slicePt1(0) + 1: slicePt3(1) = slicePt1(1): slicePt3(2) = slicePt1(2) '剖切左视图
Dim sliceObj As AutoCAD.Acad3DSolid
Set sliceObj = returnObjLeft.SliceSolid(slicePt1, slicePt2, slicePt3, True)
returnObjLeft.Delete '删除returnObjLeft,余下剖切图 ThisDrawing.SendCommand ("_Shademode" + vbCr + "_G" + vbCr) '着色 ThisDrawing.Application.ZoomExtents
End Sub

120010139

没有大虾帮帮我这个小虾米啊..

今晚打老虎

Sub 三视图显示() '俯视显示视图
ThisDrawing.SendCommand ("_-view" + vbCr + "_top" + vbCr) '找出图中齿轮实体
Dim returnObj As Object
Dim Obj3D As Boolean For Each returnObj In ThisDrawing.ModelSpace
If TypeName(returnObj) = "IAcad3DSolid" Then
Obj3D = True
Exit For
End If
Next '若图中无齿轮实体，退出过程
If Obj3D = False Then
MsgBox "图中无齿轮实体", vbOKOnly, "重要提示!"
Exit Sub
End If '获取包含实体外框的最大、最小点坐标
Dim minExt As Variant
Dim maxExt As Variant returnObj.GetBoundingBox minExt, maxExt '将齿轮实体复制3份
Dim returnObjLeft As AcadEntity '左视图
Dim returnObjTop As AcadEntity '俯视图
Dim returnObjSouthWest As AcadEntity '轴测视图 Set returnObjLeft = returnObj.Copy
Set returnObjTop = returnObj.Copy
Set returnObjSouthWest = returnObj.Copy '生成左视图
Dim pt1(2) As Double, pt2(2) As Double
pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0): pt2(1) = -pt1(1): pt2(2) = pt1(2) '旋转90度得左视图
returnObjLeft.Rotate3D pt1, pt2, 3.1415 / 2 Dim ScaleD As Double '放大视图间的距离
ScaleD = 1.2 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + (maxExt(0) - minExt(0)) * ScaleD: pt2(1) = pt1(1): pt2(2) = pt1(2) '向右移动左视图
returnObjLeft.Move pt1, pt2 '生成俯视图
pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + 1: pt2(1) = pt1(1): pt2(2) = pt1(2) '旋转90度得俯视图
returnObjTop.Rotate3D pt1, pt2, 3.1415 / 2 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0): pt2(1) = pt1(1) - (maxExt(0) - minExt(0)) * ScaleD: pt2(2) = pt1(2) '向下移动俯视图
returnObjTop.Move pt1, pt2 '生成轴测视图
pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + 1: pt2(1) = pt1(1): pt2(2) = pt1(2) '旋转45度
returnObjSouthWest.Rotate3D pt1, pt2, -3.1415 / 4 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0): pt2(1) = pt1(1) + 1: pt2(2) = pt1(2) '旋转45度
returnObjSouthWest.Rotate3D pt1, pt2, -3.1415 / 4 pt1(0) = (minExt(0) + maxExt(0)) / 2: pt1(1) = (minExt(1) + maxExt(1)) / 2: pt1(2) = _
(minExt(2) + maxExt(2)) / 2
pt2(0) = pt1(0) + (maxExt(0) - minExt(0)) * ScaleD: pt2(1) = pt1(1) - (maxExt(1) - _
minExt(1)) * ScaleD: pt2(2) = pt1(2) '向右下移动轴测视图
returnObjSouthWest.Move pt1, pt2 '三点定义左视图的剖切平面
Dim slicePt1(2) As Double
Dim slicePt2(2) As Double
Dim slicePt3(2) As Double slicePt1(0) = (minExt(0) + maxExt(0)) / 2: slicePt1(1) = (minExt(1) + maxExt(1)) / 2: _
slicePt1(2) = (minExt(2) + maxExt(2)) / 2
slicePt2(0) = slicePt1(0): slicePt2(1) = slicePt1(1) + 1: slicePt2(2) = slicePt1(2)
slicePt3(0) = slicePt1(0) + 1: slicePt3(1) = slicePt1(1): slicePt3(2) = slicePt1(2) '剖切左视图
Dim sliceObj As AutoCAD.Acad3DSolid
Set sliceObj = returnObjLeft.SliceSolid(slicePt1, slicePt2, slicePt3, True)
returnObjLeft.Delete '删除returnObjLeft,余下剖切图 ThisDrawing.SendCommand ("_Shademode" + vbCr + "_G" + vbCr) '着色 ThisDrawing.Application.ZoomExtents
End Sub

120010139

谢谢楼上的大大!!!感激之情如黄河水滔滔不绝啊:)