斜齿轮程序

Import System.MathDim A cadapp As AutoCAD .AcadApplicationDim Z As Integer ,m ,Af,Beta,B,Xn As DoubleDim R, Rf, Rb, Ra As DoubleDim 毛坯As AutoCAD. Acad3DsolidDim 齿槽As AutoCAD. Acad3DsolidPrivate Sub Form1—Load (ByVal sender As System .Object,ByVal e As System.EventArgs) Handles MyBase.LodeMe.Text=”斜齿轮造型”Me.GroupBox1. Text=””bell11. Text=”齿数z”bell12. Text=”模数m”bell13. Text=”压力角Af”bell14. Text=”螺旋角Beta”bell15. Text=”齿宽B”bell16. Text=”法向变位系数Xn”bell17. Text=”轴向精度”Me. TextBox1. Text=19Me. TextBox2. Text=6Me. TextBox3.Text=20Me. TextBox4. Text=16Me. TextBox5. Text=30Me. TextBox6. Text=0.22Me. TextBox7. Text=0.05Me.Button1.Text=”斜齿轮造型”End SubPrivate Sub Button1—Click(ByVal sender As System.Object, ByVal e As System . EventArgs) Handles Button1—ClickCall 连接AutoCAD（）Call 斜齿轮基本参数计算（）Call 毛坯造型（）Call 齿槽造型（）Call 斜齿轮造型（）Call 删除非三维实体对象（）End SubSub斜齿轮基本参数计算（）Z=Val (Me.TextBox1. Text)Beta= Val (Me.TextBox4. Text)*PI/180m= Val (Me.TextBox2. Text)m=m/Cos(Beta) ’斜齿轮端面模数Af = Val (Me.TextBox3. Text) *PI/180Af = Atan(Tan(Af)/Cos(Beta)) ’斜齿轮端面压力角B= Val (Me.TextBox5. Text)Xn= Val (Me.TextBox6. Text)’法向变位系数R=m*z/2’齿轮分度圆半径Rf=(R-(1+0.25-Xn)*m*Cos(Beta)’齿轮根圆半径Rb=R*Cos(Af)’齿轮基圆半径Ra=R+m*Cos(Beta)*(1+Xn)”齿轮顶圆半径End SubSub 毛坯造型（），根据经验公式进行毛坯造型Dim center (2) As DoubleCenter (0) =0.0# : Center (1) =0.0# : Center (2)=B / 2毛坯=Acadapp.ActiveDocument.ModelSpace.AddCylinder(Center,Ra,B)‘轴孔Dim solidobj2 As AutoCAD.Acad3DsolidDim D0 As DoubleD0 = Ra / 2solidobj2= Acadapp.ActiveDocument.ModelSpace.AddCylinder(Center,D0/2,B*1.1) 毛坯。

Boolean(AutoCAD.AcBooleanType.acSubtraction, solidobj2)‘键Dim boxObj As AutoCAD. Acad3DsolidDim length As Double , with As Double,height As DoubleaCenter (0) =0: Center (1) ==D0 / 2: Center (2) =0Length = Acadapp.ActiveDocument.ModelSpace.AddBox(Center,length,width,height) 毛坯.Boolean(AutoCAD. .AcBooleanType.acSubtraction,box0bj)毛坯.Color = AutoCAD.ACAD-COLOR.acBlueEnd SubSub 齿槽造型（）根据斜齿轮端面参数计算根据渐开线公式，计算斜齿轮端面渐开线上各点坐标Dim Sb，th（3）Sb=Cos(Af)*(PI*m/2+m*z*(Tan(Af)-(Af)))’齿轮基圆齿厚Th(1) =(PI*m* Cos(Af)- Sb)/(2*Rb)Th(0) =Th(1)/3Th(2) =Th(1)+ Tan(Af)-(Af)Th(3) =Th(1)+ Tan(Acos(Rb/Ra))- (Acos(Rb/Ra)Dim cuives(5) As AutoCAD.AcadEntityDim points0(5) As DoubleDim points0(8) As DoubleDim points0(5) As Doublepoints0(0)=0; points0(1)=Rf’第0点points0(2)=Rf*Sin(th(0)) : points0(3)= Rf*cos(th(0)) 第1点points0(4)=Rb*Sin(th(1)) : points0(5)= Rf*cos(th(1)) 第2点Dim startTan(2) As DoubleDim endtan(2) As DoublestartTan(0) = 0：startTan(1)=0：startTan(2)=0endTan(0) = 0: endTan(1)=0: endTan(2)=0points1(0) = points0(4): points0(1)= points0(5): points1(2)=0’第2点points1(3)=R*Sin（th(2)）: points1(4)=R*Cos(th(2)): points1(5)=0第3点points1(6)=Ra*Sin（th(3)）: points1(7)=R*Cos(th(3)): points1(8)=0第4点points2(0)= points1(6)= points2(1)= points1(7)第4点points2(2)= points1(6)= points2(3)= points1(7)+2.25*m第5点points2(4)= 0:points2(5)= points2(3)’第6点‘当基圆小雨根圆，调整第1，第2点坐标，得到近似值If Rb <Rf ThenPoints0(2) = points1(3)*0.2: points0(3)= points0(1)+0.25*m*0.03’第1点Points0(4) = points1(3)*0.7: points0(3)= points0(5)+0.25*m*0.8’第2点Points1(0) = points0(4): points1(1)= points0(5)：points1(2)=0’第1点End If‘创建右部线段Curves(0) = Acadapp.ActiveDocument.ModelSpace.AddCylinder(Points0) ‘由0,1,2点组成Curves(0).SetBulge(1,0.2) ‘第一点凸度为0.2‘创建样条曲线Curves(0).Acadapp.ActiveDocument.ModelSpace.Addline(Points1 ,startTan,endTen) ‘由2,3,4点组成Curves(2).Acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(Points2 ) ‘由4,5,6点组成‘镜像右部线段，得到左部线段Dim points1(2) As DoubleDim points1(2) As Doublepoints1(0) =0：points1(1) =0：points1(2) =0points2(0) =0：points2(1) =1：points2(2) =0curves(3)=curves(2).Mirror(Point1, Point2)curves(4)=curves(1).Mirror(Point1, Point2)curves(5)=curves(0).Mirror(Point1, Point2)‘创建面域Dim 齿槽轮廓As Object齿槽轮廓= Acadapp.ActiveDocument.ModelSpace.AddRegion（curves）Dim solidObj As AutoCAD.Acad3DsolidDim I As DdoubleDim startPoint(2) As DdoubleDim endPoint(2) As DdoubleDim lineObj As AutoCAD.AcadlineDim齿槽轮廓copy As AutoCAD.AcadRegionDim nstep As Ddouble’轴向精度Nstep = Val （Me.TextBox7.Txet）For i = nstep T0 1 + nstep Step nstepstartPoint(0)=0: startPoint(1)=R: startPoint(2)=B*(i- nstep)endPoint (0)=0: endPoint (1)=R: endPoint (2)B*i‘拉伸路径lineObj = Acadapp.ActiveDocument.ModelSpace.Addline(startPoint, endPoint) 齿槽轮廓copy=齿槽轮廓(0)copystartPoint(0)=0 startPoint(1)=R: startPoint(2)=0齿槽轮廓copy.Move (startPoint, endPoint)endPoint(0) = 0: endPoint(1)=0: endPoint(2):0‘旋转齿槽轮廓copy.Rotate (endPoint,Beta*i)‘沿路径拉伸If I = nstep then齿槽= Acadapp.ActiveDocument.ModelSpace.AddExtrudeSolidAlongPath(齿槽轮廓copy,lineObj)End ifsolidObj = Acadapp.ActiveDocument.ModelSpace.AddExtrudeSolidAlongPath(齿槽轮廓copy,lineObj)齿槽.Boolean(AutoCAD.AcBoolanType.acUnion,solidObj)Next齿槽.color = AutoCAD.ACAD—COLOR . acRedEnd SubSub 斜齿轮造型（）‘环形阵列Dim 齿槽阵列As ObjectDim centerPoint (2) As DdoublecenterPoint (0) = 0.0# : centerPoint (1)=0.0# centerPoint (2) =0齿槽阵列=齿槽 .ArrayPolar (Z,2*PI, centerPoint )‘毛坯与齿槽阵列进行布尔减运算On Error Resume NextDim I As IntegerFor I = 0 To Z -2毛坯.Boolean(AutoCAD.AcBoolanType.acSubtraction, 齿槽阵列(i)) Next毛坯Boolean(AutoCAD.AcBoolanType.acSubtraction, 齿槽).‘改变看图方向Dim NewDirection (2) As DdoubleNewDirection (0) = -1 : NewDirection (1) = -1 NewDirection (2) = 1Acadapp. ActiveDocument.ActiveViewport. Direction= NewDirection Acadapp. ActiveDocument.ActiveViewport= Acadapp. ActiveDocument.ActiveViewportAcadapp.ZoomExtents（）End SubSub 删除非三维实体对象（）On Error Resume NextDim returnObj As AutoCAD.AcadEntidyFor Each returnObj In Acadapp.ActiveDocument.ModelSpace.If returnObj . ObjectName < > “AcDb3dSolid ”Then End SubAcadapp.ZoomExtents（）End Sub。