关于vba开发的问题！（有图）
我在编程的时候碰到了个问题：不能对中间圆柱的两个面进行拉伸（成一定的角度如图，比如是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
呵呵!我已经解决这个问题了!
呵呵!不用大家费心了!我已经解决的这个问题了!是变量定义的时候出了问题!
页:
[1]