齿轮外形程序如何做成面域？？？－－－－急！～急！
下面是vba一个画齿轮的程序，哪位大哥愿意看看？请大哥帮忙把它做成面域。另外当齿数较大时绘出的图就不像样子了，能否帮忙改改？？小弟在此先谢谢了！！<BR>Public mnumber As Double '模数
Public znumber As Integer '齿数
Public aangle As Double '压力角
Public ha As Double '顶高系数
Public c As Double '顶隙系数
Public xscale As Double, yscale As Double
<BR>Public Sub draw_wheel()
'输入参数
mnumber = 3<BR> znumber = 20<BR> aangle = 20<BR> ha = 1<BR> c = 0.25
'如果模数或齿数有一项为0，则退出程序
If mnumber = 0 Or znumber = 0 Then
Exit Sub
End If
'将标准压力角换算成弧度
aangle = aangle * 3.1415926 / 180
'----------------------------------------
'一个齿轮在分度圆上的一些尺寸计算
Dim bangle As Double
Dim x1 As Variant, x2 As Variant
Dim y1 As Variant, y2 As Variant
bangle = 3.1415926 / 2 / znumber
'求分度圆玉左齿廓的交点
x1 = -(mnumber * znumber * Sin(bangle)) / 2<BR> <BR> y1 = (mnumber * znumber * Cos(bangle)) / 2
'求分度圆与右齿廓的交点
x2 = (mnumber * znumber * Sin(bangle)) / 2
y2 = y1
'一个齿轮在基圆上的一些尺寸计算
Dim bbangle As Double<BR> <BR> Dim inv_a As Double
Dim xb1 As Variant, yb1 As Variant
Dim xb2 As Variant, yb2 As Variant
<BR> inv_a = Tan(aangle) - aangle<BR> <BR> bbangle = 3.1415926 / 2 / znumber + inv_a
' 求基圆与左齿廓的交点
xb1 = -((mnumber * znumber * Cos(aangle) * Sin(bbangle)) / 2)
yb1 = (mnumber * znumber * Cos(aangle) * Cos(bbangle)) / 2
'求基圆与右齿廓的交点
xb2 = (mnumber * znumber * Cos(aangle) * Sin(bbangle)) / 2
yb2 = yb1
<BR> '一个齿在顶圆上的一些尺寸计算
Dim aaangle As Double
Dim baangle As Double
Dim inv_aa As Double
Dim xa1 As Variant, ya1 As Variant
Dim xa2 As Variant, ya2 As Variant
Dim a1 As Double
<BR> a1 = (((znumber + 2 * ha) ^ 2) / (znumber * Cos(aangle)) ^ 2) - 1<BR> <BR> inv_aa = Sqr(a1)<BR> <BR> aaangle = Atn(Sqr(a1))
inv_aa = inv_aa - aaangle
baangle = 3.1415926 / (2 * znumber) - (inv_aa - inv_a)
'求顶圆与左齿廓的交点
xa1 = -(znumber + 2 * ha) * mnumber * Sin(baangle) / 2
ya1 = (znumber + 2 * ha) * mnumber * Cos(baangle) / 2
'求顶圆与右齿廓的交点
xa2 = (znumber + 2 * ha) * mnumber * Sin(baangle) / 2
ya2 = ya1
'一个轮齿顶圆中点的坐标
Dim xaz As Variant, yaz As Variant
xaz = 0<BR> yaz = (znumber + 2 * ha) * mnumber / 2
'-----------------------------------------------------------------<BR> '新建图纸<BR> <BR> Dim appObj As AcadApplication<BR> <BR> Dim dwgFile As AcadDocument<BR> <BR> Set appObj = ThisDrawing.Application<BR> <BR> Set dwgFile = appObj.Documents.Add
<BR> '------------------------------------------------------------------------
'定义一个轮齿图块
Dim blockobj As AcadBlock
Dim inspnt(0 To 2) As Double
Dim allent As AcadEntity
Dim blkref As AcadBlockReference
Dim blkcount As Integer<BR> <BR> Dim blkname As String
<BR> ' 判断在模型空间已有的齿廓图块数量
For Each allent In ThisDrawing.ModelSpace
If StrComp(allent.EntityName, "acdbblockreference", 1) = 0 Then
Set blkref = allent
If StrComp(Left(blkref.Name, 7), "blkgear", 1) = 0 Then<BR> <BR> blkcount = blkcount + 1
End If
End If
Next<BR> <BR> blkcount = blkcount + 1
<BR> '创建齿廓图块
inspnt(0) = 0<BR> inspnt(1) = 0<BR> inspnt(2) = 0
blkname = "blkgear" & blkcount
Set blockobj = ThisDrawing.Blocks.Add(inspnt, blkname)
'--------------------------------------------------------------------
'准备画齿廓
Dim stan(0 To 2) As Double
Dim etan(0 To 2) As Double
Dim fitpnts(0 To 8) As Double
Dim splinel As AcadSpline
Dim spliner As AcadSpline
<BR> stan(0) = 0<BR> stan(1) = 0<BR> stan(2) = 0
etan(0) = 0<BR> etan(1) = 0<BR> etan(2) = 0
fitpnts(0) = xb1<BR> fitpnts(1) = yb1<BR> fitpnts(2) = 0
fitpnts(3) = x1<BR> fitpnts(4) = y1<BR> fitpnts(5) = 0<BR> <BR> fitpnts(6) = xa1<BR> fitpnts(7) = ya1<BR> fitpnts(8) = 0
'在块中插入左齿廓
Set splinel = blockobj.AddSpline(fitpnts, stan, etan)
<BR> fitpnts(0) = xb2<BR> fitpnts(1) = yb2<BR> fitpnts(2) = 0
fitpnts(3) = x2<BR> fitpnts(4) = y2<BR> fitpnts(5) = 0
fitpnts(6) = xa2<BR> fitpnts(7) = ya2<BR> fitpnts(8) = 0
'在块中插入右齿廓
Set spliner = blockobj.AddSpline(fitpnts, stan, etan)
'---------------------------------------------------------------------
'画齿顶圆弧
Dim ra As Double
Dim sang As Double, eang As Double
Dim arcobj As AcadArc
<BR> '求顶圆的半径
ra = (znumber + 2 * ha) * mnumber / 2
sang = 3.1415926 / 2 - baangle
eang = 3.1415926 / 2 + baangle
'注意圆心要使用块的插入点
Set arcobj = blockobj.AddArc(inspnt, ra, sang, eang)
'-----------------------------------------------------------------
'画齿根过渡圆弧
Dim zangle As Double
Dim aveang As Double
Dim rf As Double
Dim gd_x1 As Double, gd_y1 As Double
Dim poly_arc As AcadLWPolyline
Dim points(0 To 3) As Double
'求出每半个齿间距对应的角度
zangle = (360 / znumber / 2) * (3.1415926 / 180)
'求过渡圆弧和根圆接触点到齿轮中心连线与垂直轴的夹角
aveang = (bbangle + zangle) / 2
'求根圆的半径
rf = (znumber - 2 * ha - 2 * c) * mnumber / 2
'过渡圆弧与根圆接触点的坐标
gd_x1 = rf * Sin(aveang)
gd_y1 = rf * Cos(aveang)
'在基圆与齿廓的交点和根圆与过渡圆弧的接触点创建多义线
points(0) = xb2<BR> points(1) = yb2
points(2) = gd_x1<BR> points(3) = gd_y1
Set poly_arc = blockobj.AddLightWeightPolyline(points)
<BR> '将多义线变成圆弧
poly_arc.SetBulge 0, 0.2
poly_arc.Update
'-----------------------------------------------------------------------<BR> <BR> '插入齿根圆弧段
Dim arcfobj As AcadArc
<BR> sang = 3.1415926 / 2 - zangle
eang = 3.1415926 / 2 - aveang
'注意圆心要使用块的插入点
Set arcfobj = blockobj.AddArc(inspnt, rf, sang, eang)
'----------------------------------------------------------------
'镜像过渡圆弧和齿根圆弧
Dim mirpnt1(0 To 2) As Double
Dim mirpnt2(0 To 2) As Double
Dim poly_arc1 As AcadLWPolyline
Dim arcfobj1 As AcadArc
<BR> '建立镜像轴
mirpnt1(0) = xaz<BR> mirpnt1(1) = yaz<BR> mirpnt1(2) = 0
mirpnt2(0) = 0<BR> mirpnt2(1) = 0<BR> mirpnt2(2) = 0
<BR> '镜像过渡圆弧段
Set poly_arc1 = poly_arc.Mirror(mirpnt1, mirpnt2)
'镜像齿根圆弧段
Set arcfobj1 = arcfobj.Mirror(mirpnt1, mirpnt2)
'--------------------------------------------------------------
'准备插入齿廓
Dim blkrefobj As AcadBlockReference
Dim insertpnt As Variant
Dim rotangle As Double
Dim i As Integer<BR> <BR> Dim a(0 To 2) As Double<BR> <BR> a(0) = 300<BR> a(1) = 300<BR> a(2) = 0
insertpnt = a<BR> <BR> <BR> '预设x和y轴的比例因子
xscale = 1<BR> yscale = 1
<BR> On Error Resume Next<BR>
'根据齿数循环将齿廓插入到模型空间
For i = 0 To znumber - 1
rotangle = i * (360 / znumber) * 3.1415926 / 180
Set blockrefobj = ThisDrawing.ModelSpace.InsertBlock(insertpnt, blkname, xscale, yscale, 1#, rotangle)
<BR> Dim expobj As Variant<BR> <BR> expobj = blockrefobj.Explode<BR>
Next
ZoomAll<BR> <BR> <BR>End Sub<BR> 1.对象炸开后要把原图块删除，这一点程序的做法与实际画图不图。<BR>2.你所绘制的图形中，齿根圆与齿轮廓不相交，所以形成不了封闭的图形，无法转换为面域。 十分感谢大哥帮忙！！！
程序画出图后在模型中， 使用 工具－－>查询－－>点坐标 查看齿根圆与齿廓相交的两段线的端点坐标相同，应该认为它们是相交的吧。
另外，当齿数较少时，如10个左右。用程序画出图以后，再在模型里用鼠标操作创建面域就能成功！小弟实在不知为什么？恳请哪位大哥再帮忙看看！ 这关键就是计算精度的问题。所以建议你先完成圆弧的建模，然后在生成样条曲线时的起点终点使用原来圆弧的终点坐标，而不要再计算，这样才能保证精度。<BR>原因，生成圆弧是使用半径和角度来生成，所以最后出来的两个端点坐标与计算的样条线端点坐标有些差异。 谢谢了！～
我更改了思路，先画一个齿，打散，作面域，成功了。但是块删了，打散后的东东不知如何删去。一个齿的面域生成后，我把它画成齿轮形状了，鼠标操作布尔合并成功。但不知如何程序实现，望老大赐教！～ 我用vba做了两个面域，不能进行布尔运算，头都大了
页:
[1]