关于vba开发的问题！（有图）

lcj68

我在编程的时候碰到了个问题：不能对中间圆柱的两个面进行拉伸（成一定的角度如图，比如是45度等）
原程序：
    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 'Val(蜗杆数据输入.Combo1.Text) '模数
    wf = 80 'Val(蜗杆数据输入.Text2(0).Text) '蜗杆分度圆直径
    wk = 100 'Val(蜗杆数据输入.Text3(1).Text) '蜗杆宽度
   
    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 b As AcadCircle
    Dim b2(3) 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(2), mirpt2(2) As Double
    circlepoint(0) = 0: circlepoint(1) = 0: circlepoint(2) = wk / 2
    r1 = wd / 2
    Set b = 蜗杆cad.ActiveDocument.ModelSpace.AddCircle(circlepoint, r1)
   
    '拉伸该圆，成45度角
    Dim bface As Variant
    bface = 蜗杆cad.ActiveDocument.ModelSpace.AddRegion(b)
    height = wd / 2
    taperangle = 45 * 3.14 / 360
    Set b2(0) = 蜗杆cad.ActiveDocument.ModelSpace.AddExtrudedSolid(bface, height, taperangle)
    circlepoint1(0) = 0: circlepoint1(1) = 0: circlepoint1(2) = wd + wk / 2
    Set b2(1) = 蜗杆cad.ActiveDocument.ModelSpace.AddCylinder(centerpoint1, wd / 4, wd)
   
    mirpt1(0) = 0: mirpt1(1) = 1: mirpt1(2) = 0
    mirpt2(0) = 1: mirpt2(1) = 0: mirpt2(2) = 0
    Set b2(3) = b2(0).Mirror3D(centerpoint, mirpt1, mirpt2)
    Set b2(3) = b2(1).Mirror3D(centerpoint, mirpt1, mirpt2)
    蜗杆3d.Boolean acUnion, b()
    蜗杆3d.UpdateC:\WINDOWS\Desktop

lcj68

呵呵!不用大家费心了!我已经解决的这个问题了!是变量定义的时候出了问题!