|
|
发表于 2003-5-13 09:09:00
|
显示全部楼层
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'用边界生成的面域好像都有这个问题，我也不懂，等待高手解决
好像你应该删的是regobj吧，b（0）已经删掉了的 |
|
置顶卡
