高手帮忙解决我的齿轮二次开发程序问题。。。
本帖最后由 作者 于 2008-4-28 16:59:16 编辑 <br /><br /> <p>我做的这个齿轮二次开发程序,老师要求做成三维的。</p><p>现在我的二维图已经初具雏形。但是在面域的生成上卡壳了,实在不知道该怎么去生成面域,请各位高手指点一下。</p><p>还有就是,我做的这个程序当齿数大于35的时候,画出来的齿轮就乱七八糟,我不知道该怎么改进,也请各位帮忙了。</p><p>主要的程序如下:</p><p>Private Sub CommandButton1_Click()<br/>Dim m As Double, z As Double, b As Double, afa As Double, c As Double<br/>Dim ha As Double<br/>Dim Center(0 To 2) As Double<br/>Dim Ra As Double, R As Double, Rf As Double, Rb As Double<br/>m = Val(TextBox1.Text)<br/>z = Val(TextBox2.Text)<br/>afa = Val(TextBox3.Text)<br/>ha = Val(TextBox4.Text)<br/>c = Val(TextBox5.Text)<br/>b = Val(TextBox6.Text)<br/>Center(0) = 0<br/>Center(1) = 0<br/>Center(2) = 0<br/>afa = afa * (Atn(1) * 4) / 180<br/>R = m * z / 2<br/>Rf = (R - (ha + c) * m)<br/>Rb = R * Cos(afa)<br/>Ra = (z + 2 * ha) * m / 2<br/>Dim lunchiObj As AcadBlock<br/>Dim insertionPnt(0 To 2) As Double<br/>insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0<br/>Set lunchiObj = ThisDrawing.Blocks.Add(insertionPnt, "curves")<br/> <br/>Dim Sb As Double<br/>Dim Th(0 To 3) As Double<br/>Sb = Cos(afa) * (3.14 * m / 2 + m * z * (Tan(afa) - (afa)))<br/>Th(1) = Sb / (2 * Rb)<br/>Th(0) = Th(1) / 3<br/>Th(3) = Th(1) - Tan(Acos(Rb / Ra)) + Acos(Rb / Ra)<br/>Th(2) = Th(1) - Tan(afa) + afa<br/>Dim curves(0 To 7) As AcadEntity<br/>Dim Points0(0 To 5) As Double<br/>Dim Points1(0 To 8) As Double<br/>Dim Points2(0 To 5) As Double<br/>Points0(0) = 0: Points0(1) = Ra<br/>Points0(2) = Points0(0): Points0(3) = Points0(1)<br/>Points0(4) = Ra * Sin(Th(3)): Points0(5) = Ra * Cos(Th(3))<br/>Dim sTan(0 To 2) As Double<br/>Dim eTan(0 To 2) As Double<br/>sTan(0) = 0: sTan(1) = 0: sTan(2) = 0<br/>eTan(0) = 0: eTan(1) = 0: eTan(2) = 0<br/>Points1(0) = Points0(4): Points1(1) = Points0(5): Points1(2) = 0<br/>Points1(3) = R * Sin(Th(2)): Points1(4) = R * Cos(Th(2)): Points1(5) = 0<br/>Points1(6) = Rb * Sin(Th(1)): Points1(7) = Rb * Cos(Th(1)): Points1(8) = 0<br/>'''''''''''''''''''''''''''''''''''''''''''''''''''<br/>Points2(0) = Points1(6): Points2(1) = Points1(7)<br/>Points2(2) = Rf * Sin(Th(1) + Th(0)): Points2(3) = Rf * Cos(Th(1) + Th(0))<br/>Points2(4) = Points2(2): Points2(5) = Points2(3)<br/>If Rb < Rf Then<br/>Points1(6) = R * Sin(Th(2)) * 0.7: Points1(7) = Rf + 0.25 * m * 0.8: Points1(8) = 0<br/>Points2(0) = Points1(6): Points2(1) = Points1(7)<br/>Points2(2) = R * Sin(Th(2)) * 0.2: Points2(3) = Rf + 0.25 * m * 0.03: Points1(2) = 0<br/>End If<br/>Set curves(0) = lunchiObj.AddLightWeightPolyline(Points0)<br/>curves(0).Update<br/>Set curves(1) = lunchiObj.AddSpline(Points1, sTan, eTan)<br/>curves(1).Update<br/>Set curves(2) = lunchiObj.AddLightWeightPolyline(Points2)<br/>curves(2).SetBulge 1, 0.2<br/>curves(2).Update<br/>Dim sAn As Double, eAn As Double<br/>eAn = Atn(1) * 2 - (Th(0) + Th(1))<br/>sAn = Atn(1) * 2 - Atn(1) * 8 / (2 * z)<br/>Set curves(3) = lunchiObj.AddArc(Center, Rf, sAn, eAn)<br/>curves(3).Update<br/>Dim point1(0 To 2) As Double<br/>Dim point2(0 To 2) As Double<br/>point1(0) = 0: point1(1) = 0: point1(2) = 0<br/>point1(0) = 0: point1(1) = 1: point1(2) = 0<br/>Set curves(4) = curves(0).Mirror(point1, point2)<br/>Set curves(5) = curves(1).Mirror(point1, point2)<br/>Set curves(6) = curves(2).Mirror(point1, point2)<br/>Set curves(7) = curves(3).Mirror(point1, point2)<br/>Dim blockRefObj As AcadBlockReference<br/>insertionPnt(0) = 0: insertionPnt(1) = 0: insertionPnt(2) = 0<br/>Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "curves", 1, 1, 1, 0)<br/>Dim retObj As Variant<br/>Dim basePnt(0 To 2) As Double<br/>'basePnt(0) = 0#: basePnt(1) = 0#: basePnt(2) = 0#<br/>retObj = blockRefObj.ArrayPolar(z, Atn(1) * 8, Center)<br/>ZoomAll<br/>ThisDrawing.Regen acAllViewports<br/>Unload Me<br/>End Sub</p> <p>我的问题跟你一样呢,我也不知道怎样生成面域呢。</p> <p>我的邮箱:<a href="mailto:wangpeng1305@163.com">wangpeng1305@163.com</a></p><p>希望高手来给帮忙啊!!</p>
页:
[1]