这是一个面域删除的问题!

lcj68

我用object.delete就是删除不了!为什么呢?请教各位同学,老师!!!谢谢!

lcj68

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

hillskysea

同问，我的也出现这种情况

hillskysea

用边界生成的面域好像都有这个问题，我也不懂，等待高手解决

好像你应该删的是regobj吧，b（0）已经删掉了的