这是一个面域删除的问题!
我用object.delete就是删除不了!为什么呢?请教各位同学,老师!!!谢谢!原程序如下:
On Error Resume Next'关闭上次运行的文件
蜗杆cad.Document.Add '新建一文件
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'蜗杆宽度
Dim newdirection(0 To 2) As Double '设置三维视点
newdirection(0) = 1: newdirection(1) = 0: newdirection(2) = 1
cad.ActiveDocument.ActiveViewport.Direction = newdirection
cad.ActiveDocument.ActiveViewport =cad.ActiveDocument.ActiveViewport
cad.ActiveDocument.SendCommand "_shademode" + vbCr + "_g" + vbCr
'毛坏
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 = cad.ActiveDocument.ModelSpace.AddCylinder(centerpoint, wd / 2, wk)
Dim b2 As Acad3DSolid
Dim curves1 As Acad3DSolid, curves2 As Acad3DSolid
Dim height As Double
Dim taperangle As Double
Dim circlepoint(2) As Double
Dim circlepoint1(2) As Double
Dim r1 As Double
Dim mirpt1(0 To 2) As Double, mirpt2(0 To 2) As Double, mirpt3(0 To 2) As Double
circlepoint(0) = 0: circlepoint(1) = 0: circlepoint(2) = wk / 2
r1 = wd / 2
Dim b(0) As AcadCircle
Set b(0) = cad.ActiveDocument.ModelSpace.AddCircle(circlepoint, r1)
'拉伸该圆柱,成45度角
Dim regionObj As Variant
regionObj = cad.ActiveDocument.ModelSpace.AddRegion(b)
b(0).Delete'<<<<<<!----(就是这条语句不能执行,不知是为什么)
height = 10
taperangle = 45 * 3.14 / 180
Set curves1 = cad.ActiveDocument.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperangle)
circlepoint1(0) = 0: circlepoint1(1) = 0: circlepoint1(2) = wd + wk / 2
Set b2 = cad.ActiveDocument.ModelSpace.AddCylinder(centerpoint, wd / 4, 2.5 * wd + 4)
'
mirpt1(0) = 0: mirpt1(1) = 0: mirpt1(2) = 0
mirpt2(0) = 1: mirpt2(1) = 0: mirpt2(2) = 0
mirpt3(0) = 0: mirpt3(1) = 1: mirpt3(2) = 0
Set curves2 = curves1.Mirror3D(mirpt1, mirpt2, mirpt3)
蜗杆3d.Boolean acUnion, b2
蜗杆3d.Boolean acUnion, curves1
蜗杆3d.Boolean acUnion, curves2
蜗杆3d.Update
ZoomExtents 同问,我的也出现这种情况 本帖最后由 作者 于 2009-6-4 23:48:04 编辑 <br /><br /> <p>用边界生成的面域好像都有这个问题,我也不懂,等待高手解决</p><p>好像你应该删的是regobj吧,b(0)已经删掉了的</p>
页:
[1]