用vb编写的直齿圆柱齿轮参数化设计的完整程序
 

用vb编写的直齿圆柱齿轮参数化设计的完整程序
www.dimcax.com
用vb编写的直齿圆柱齿轮参数化设计的完整程序
本人要弄个直齿圆柱齿轮,要求用vb编写的,但是不太会,请各路朋友帮助.

呵呵，我还没有做呢，毕业设计其中一个内容，做完告诉你....

你做多少了啊，我做了一些，但有个问题，就是菜单和齿轮程序联接不上。还有就是输入负数时，齿轮也一样生成，解决这两个问题，算是可以成功了。
谁会的也可以教教我~~~

private sub commandbutton1_click()
dim 齿顶圆 as acadcircle, 齿根圆 as acadcircle, 基圆 as acadcircle, 分度圆 as acadcircle
dim da as double, df as double, db as double, d as double
dim z as integer, m as single, 齿顶高系数 as single, 顶隙系数 as single, a as single
dim center(0 to 2) as double
const pi as single = 3.14159
'给各参数赋值
center(0) = 0: center(1) = 0: center(2) = 0
z = val(textbox2.text)
m = val(textbox1.text)
a = val(textbox3.text)
齿顶高系数 = val(textbox4.text)
顶隙系数 = val(textbox5.text)
'计算各圆半径
da = ((z + 2 * 齿顶高系数) * m) / 2
df = ((z - 2 * 齿顶高系数 - 2 * 顶隙系数) * m) / 2
db = (z * cos(a * pi / 180) * m) / 2
d = (z * m) / 2
'生成各圆
set 齿顶圆 = thisdrawing.modelspace.addcircle(center, da)
set 齿根圆 = thisdrawing.modelspace.addcircle(center, df)
set 基圆 = thisdrawing.modelspace.addcircle(center, db)
set 分度圆 = thisdrawing.modelspace.addcircle(center, d)
'建立齿顶圆面域
dim curves(0 to 1) as acadentity
set curves(0) = thisdrawing.modelspace.addarc(center, da, 0, 3.14)
set curves(1) = thisdrawing.modelspace.addarc(center, da, 3.14, 0)
dim reg as variant
reg = thisdrawing.modelspace.addregion(curves)
'建立拉伸路径
dim l as acadline
dim p1(0 to 2) as double, p2(0 to 2) as double
dim 齿轮厚度 as double
齿轮厚度 = textbox6.text
p1(0) = 0: p1(1) = 0: p1(2) = 0
p2(0) = 0: p2(1) = 0: p2(2) = 齿轮厚度
set l = thisdrawing.modelspace.addline(p1, p2)
'拉伸齿顶圆
dim solid as acad3dsolid
set solid = thisdrawing.modelspace.addextrudedsolidalongpath(reg(0), l)
'生成渐开线
dim curvess(0 to 7) as acadentity
dim point(0 to 181) as double
dim i as integer
for i = 0 to 180 step 2 '得到各点
point(i) = db * (cos(i * pi / 360) + (i * pi / 360) * sin(i * pi / 360))
point(i + 1) = db * (sin(i * pi / 360) - (i * pi / 360) * cos(i * pi / 360))
next
set curvess(0) = thisdrawing.modelspace.addlightweightpolyline(point) '轻便多义线绘成的渐开线
'确定镜像点
dim mir1(0 to 2) as double, mir2(0 to 2) as double
mir1(0) = 0: mir1(1) = 0: mir1(2) = 0
mir2(0) = 1: mir2(1) = 0: mir2(2) = 0
'绘出封闭的外齿形
set curvess(4) = curvess(0).mirror(mir1, mir2)
dim dd as double
dd = 1.9 * pi / 180 - pi / z
curvess(4).rotate center, dd
dim point1(0 to 2) as double, point2(0 to 2) as double, point3(0 to 2) as double
dim point4(0 to 2) as double, point5(0 to 2) as double, point6(0 to 2) as double
point1(0) = point(180): point1(1) = point(181): point1(2) = 0
point2(0) = db: point2(1) = 0: point2(2) = 0
point3(0) = df: point3(1) = 0: point3(2) = 0
point4(0) = point(180) + 5: point4(1) = point(181): point4(2) = 0
set curvess(7) = thisdrawing.modelspace.addline(point1, point4)
set curvess(5) = curvess(7).mirror(mir1, mir2)
curvess(5).rotate center, dd
set curvess(1) = thisdrawing.modelspace.addline(point2, point3)
set curvess(3) = curvess(1).mirror(mir1, mir2)
curvess(3).rotate center, dd
set curvess(6) = thisdrawing.modelspace.addline(curvess(5).endpoint, curvess(7).endpoint)
set curvess(2) = thisdrawing.modelspace.addline(curvess(1).endpoint, curvess(3).endpoint)
'建立外齿形面域
dim reg2 as variant
reg2 = thisdrawing.modelspace.addregion(curvess)
'拉伸外齿形
dim solid1 as acad3dsolid
set solid1 = thisdrawing.modelspace.addextrudedsolidalongpath(reg2(0), l)
'boolean运算，生成参数齿轮
dim solid2(1 to 100) as acad3dsolid
dim zz as double
zz = 2 * pi / z

dim ii as integer
for ii = 1 to 1
set solid2(ii) = solid1.copy()
solid1.rotate center, zz
solid.boolean acintersection, solid2(ii)
next
'建立图层并把各对象分配到指定图层
dim lay(0 to 1) as acadlayer
set lay(0) = thisdrawing.layers.add("我的图层")
基圆.layer = "我的图层"
solid1.layer = "我的图层"
齿顶圆.layer = "我的图层"
齿根圆.layer = "我的图层"
分度圆.layer = "我的图层"
reg(0).layer = "我的图层"
reg2(0).layer = "我的图层"
curves(0).layer = "我的图层"
curves(1).layer = "我的图层"
curvess(0).layer = "我的图层"
curvess(1).layer = "我的图层"
curvess(2).layer = "我的图层"
curvess(3).layer = "我的图层"
curvess(4).layer = "我的图层"
curvess(5).layer = "我的图层"
curvess(6).layer = "我的图层"
curvess(7).layer = "我的图层"
l.layer = "我的图层"
lay(0).layeron = false
set lay(1) = thisdrawing.layers.add("齿轮")
solid.layer = "齿轮"
lay(1).layeron = true
'建立内径圆
dim 圆(0 to 0) as acadentity
dim 内径 as double, 键槽宽b(0 to 2) as double
内径 = val(textbox7.text) / 2
set 圆(0) = thisdrawing.modelspace.addcircle(center, 内径)
'建立面域和拉伸面域
dim reg3 as variant
dim solid3 as acad3dsolid
reg3 = thisdrawing.modelspace.addregion(圆)
set solid3 = thisdrawing.modelspace.addextrudedsolidalongpath(reg3(0), l)

这里有点代码，希望大家可以给我意见改进。

你现在搞的怎么样了？

希望这个对我有用

请问你编写的二次开发程序是三维的吗？是用cad，还是用的pro/e？

ding........................

我也想要啊，分享下啊

程序编的还好
可以运行
只是齿轮没有做出键槽部分
可以参考一下这段程序
dim jianregion as variant
dim jianpnt1(0 to 2) as double
dim jianpnt2(0 to 2) as double
dim jianpnt3(0 to 2) as double
dim jianpnt4(0 to 2) as double
jianpnt1(0) = 0: jianpnt1(1) = 键槽宽b.text / 2: jianpnt1(2) = 0
jianpnt2(0) = 轮毂键槽高h.text - 轮毂直径dn / 2: jianpnt2(1) = 键槽宽b.text / 2: jianpnt2(2) = 0
jianpnt3(0) = 轮毂键槽高h.text - 轮毂直径dn / 2: jianpnt3(1) = -键槽宽b.text / 2: jianpnt3(2) = 0
jianpnt4(0) = 0: jianpnt4(1) = -键槽宽b.text / 2: jianpnt4(2) = 0
set jianlunkuolines(0) = thisdrawing.modelspace.addline(jianpnt1, jianpnt2)
set jianlunkuolines(1) = thisdrawing.modelspace.addline(jianpnt2, jianpnt3)
set jianlunkuolines(2) = thisdrawing.modelspace.addline(jianpnt3, jianpnt4)
set jianlunkuolines(3) = thisdrawing.modelspace.addline(jianpnt4, jianpnt1)
jianregion = thisdrawing.modelspace.addregion(jianlunkuolines)
for i = 0 to 3
jianlunkuolines(i).delete
next i
set jiansolid = thisdrawing.modelspace.addextrudedsolidalongpath(jianregion(0), l)
jianregion(0).delete
solid.boolean acsubtraction, jiansolid
l.delete