form1.vb

基于vb.net的齿轮三维参数化造型设计包括齿轮结构参数化设计和结构三维造型设计

    End Sub

    '齿轮结构造型
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Call 连接AutoCAD()

        ' 遍历模型空间的所有成员，删除一切实体
        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
            entry.Delete()
        Next

        '设置三维视点
        Dim NewDirection(2) As Double
        NewDirection(0) = 1 : NewDirection(1) = 0.5 : NewDirection(2) = 0.5
        AcadApp.ActiveDocument.ActiveViewport.Direction = NewDirection
        AcadApp.ActiveDocument.ActiveViewport = AcadApp.ActiveDocument.ActiveViewport

        AcadApp.ActiveDocument.Layers.Item(0).Color = AutoCAD.AcColor.acRed '层0设为红色

        AcadApp.ActiveDocument.SendCommand("_Shademode" + vbCr + "_G" + vbCr) '着色        '

        '齿轮输入参数
        Z = Val(Me.TextBox1.Text)      '齿数
        m = Val(Me.TextBox2.Text)      '模  数
        Af = Val(Me.TextBox3.Text) * Pi / 180     '压力角


        '齿轮毛坯造型

        Da = m * Z + 2 * m

        D4 = Val(Me.TextBox4.Text)   '轴径
        D3 = Val(Me.TextBox7.Text)
        D0 = Val(Me.TextBox6.Text)
        D1 = (D0 + D3) / 2
        D2 = (D0 - D3) * 0.3

        B = Val(Me.TextBox5.Text)   '齿宽
        C = 0.2 * B
        n1 = 0.5 * m
        If Da <= 160 Then C = B : D0 = (Da + D4) / 2 : D3 = D0 : D2 = 0 : Me.CheckBox1.Checked = False

        Dim plineObj(1) As AutoCAD.AcadLWPolyline
        Dim points(19) As Double
        '定义2D多义线点
        points(0) = 0 : points(1) = D4 / 2 '1点的X，Y坐标
        points(2) = B / 2 - n1 : points(3) = points(1) '2点
        points(4) = points(2) + n1 : points(5) = points(3) + n1 '3点
        points(6) = points(4) : points(7) = D3 / 2 '4点
        points(8) = C / 2 : points(9) = points(7) + n1 '5点
        points(10) = points(8) : points(11) = D0 / 2 - n1 '6点
        points(12) = points(6) : points(13) = points(11) + n1 '7点
        points(14) = points(12) : points(15) = Da / 2 - n1 '8点
        points(16) = points(14) - n1 : points(17) = points(15) + n1 '9点
        points(18) = 0 : points(19) = points(17) '10点
        '创建AddLightWeightPolyline多义线
        plineObj(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points)
        plineObj(0).Closed = True


        '镜象1-10点围成的图形
        Dim point1(2) As Double
        Dim point2(2) As Double
        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
        point2(0) = 0 : point2(1) = 1 : point2(2) = 0

        plineObj(1) = plineObj(0).Mirror(point1, point2)


        '创建为面域
        Dim regionObj As Object
        regionObj = AcadApp.ActiveDocument.ModelSpace.AddRegion(plineObj)

        '布尔加运算
        regionObj(0).Boolean(AutoCAD.AcBooleanType.acUnion, regionObj(1))

        '旋转面域
        Dim axisPt(2) As Double
        Dim axisDir(2) As Double
        Dim angle As Double
        axisPt(0) = 0 : axisPt(1) = 0 : axisPt(2) = 0
        axisDir(0) = 1 : axisDir(1) = 0 : axisDir(2) = 0
        angle = 2 * Pi


        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)

        AcadApp.ZoomExtents()


        '为了造型方便，将得到的齿轮结构旋转体绕Y轴旋转90度。
        Dim rotatePt1(2) As Double
        Dim rotatePt2(2) As Double
        Dim rotateAngle As Double

        rotatePt1(0) = 0 : rotatePt1(1) = 0 : rotatePt1(2) = 0
        rotatePt2(0) = 0 : rotatePt2(1) = 1 : rotatePt2(2) = 0
        rotateAngle = 90
        rotateAngle = rotateAngle * Pi / 180.0#


        solidObj.Rotate3D(rotatePt1, rotatePt2, rotateAngle)

        '键
        Dim boxObj As AutoCAD.Acad3DSolid
        Dim length As Double, width As Double, height As Double
        Dim center(2) As Double

        center(0) = 0 : center(1) = -D4 / 2 : center(2) = 0
        length = D4 * 0.3 : width = D4 * 0.3 : height = B * 1.1

        boxObj = AcadApp.ActiveDocument.ModelSpace.AddBox(center, length, width, height)
        solidObj.Boolean(AutoCAD.AcBooleanType.acSubtraction, boxObj)

        Dim i As Integer

        '腹板孔
        If Me.CheckBox1.Checked = True Then
            Dim cylinderObj As AutoCAD.Acad3DSolid
            Dim radius As Double
            center(0) = 0.0# : center(1) = D1 / 2 : center(2) = 0.0#
            radius = D2 / 2
            height = C * 1.1
            cylinderObj = AcadApp.ActiveDocument.ModelSpace.AddCylinder(center, radius, height)

            '环形阵列
            Dim retObj As Object
            Dim basePnt(2) As Double
            basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
            retObj = cylinderObj.ArrayPolar(7, 2 * Pi, basePnt)

            For i = 0 To 5
                solidObj.Boolean(AutoCAD.AcBooleanType.acSubtraction, retObj(i))
            Next i
        End If

        Call 齿轮刀具()

        For i = 0 To Z - 1
            solidObj.Boolean(AutoCAD.AcBooleanType.acSubtraction, 刀具(i))
        Next i

        ' 遍历模型空间的所有成员，删除非齿轮结构实体的一切实体
        For Each entry In AcadApp.ActiveDocument.ModelSpace
            If entry.ObjectID <> solidObj.ObjectID Then
                entry.Delete()
            End If
        Next

        solidObj.Update()
        AcadApp = Nothing

    End Sub

    Sub 齿轮刀具()
        Dim R, Rf, Rb, Ra As Single

        R = m * Z / 2 '齿轮分度圆半径
        Rf = (R - 1.25 * m) '齿轮根圆半径
        Rb = R * Cos(Af)  '齿轮基圆半径
        Ra = R + m ' 齿轮顶圆半径

        '根据渐开线公式,计算渐开线上各点坐标
        Dim Sb, th(3)
        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))   ' 齿轮基圆齿厚
        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
        th(0) = th(1) / 3
        th(2) = th(1) + Tan(Af) - Af
        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)

        Dim curves(5) As AutoCAD.AcadEntity
        Dim points0(5) As Double
        Dim points1(8) As Double
        Dim points2(5) As Double

        points0(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) = Rb * Cos(th(1)) '第2点

        Dim startTan(2) As Double
        Dim endTan(2) As Double
        startTan(0) = 0 : startTan(1) = 0 : startTan(2) = 0
        endTan(0) = 0.5 : endTan(1) = 0.5 : endTan(2) = 0

        points1(0) = points0(4) : points1(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) = Ra * 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 Then
            points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03 '第1点
            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8 '第2点
            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0 '第2点
        End If

        '创建右部线段
        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)     '由0，1，2点组成
        curves(0).SetBulge(1, 0.2) '第一点凸度为0.2
        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)     '由2，3，4点组成
        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)     '由4，5，6点组成

        '镜像右部线段，得到左部线段
        Dim point1(2) As Double
        Dim point2(2) As Double
        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
        point2(0) = 0 : point2(1) = 1 : point2(2) = 0
        curves(3) = curves(2).Mirror(point1, point2)
        curves(4) = curves(1).Mirror(point1, point2)
        curves(5) = curves(0).Mirror(point1, point2)

        '创建面域
        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
        '创建面域
        Dim taperAngle As Double
        taperAngle = 0
        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
        Dim center(2) As Double
        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
        solidObj.Move(solidObj.Centroid, center)

        '环形阵列
        Dim basePnt(2) As Double
        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
    End Sub

    '齿数、模数改变，其他结构参数根据经验公式改变
    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3) '轴径D4
        D4 = Val(Me.TextBox4.Text)
        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text)) '齿宽B
        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text) 'D0
        Me.TextBox7.Text = 1.6 * D4 'D3

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        End
    End Sub

    Sub 连接AutoCAD()
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
            If Err.Number Then
                MsgBox("不能运行AutoCAD,请检查是否安装了AutoCAD")
                Exit Sub
            End If
        End If
        AcadApp.Visible = True '界面可视
        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '显示AutoCAD界面
    End Sub


End Class