基于autocad的齿轮参数化源程序

圣歌

Imports System.Math
2 h1 t4 o, k4 o. {% Y7 {Public Class Form1
    Dim AcadApp As AutoCAD.AcadApplication
    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
+ ^0 B& B$ b' s# O) N    Dim Z, m, Af As Double
    Const Pi = 3.141592
! _: ^$ |- w  u/ E0 b! h    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
# Z3 A# `" x5 ?( o+ r. i        Me.Text = "齿轮结构参数化三维造型"
        Me.GroupBox1.Text = ""
; s( V8 D5 m8 O" i. H# ^        Me.Label1.Text = "齿数Z"
        Me.Label2.Text = "模数m"
        Me.Label3.Text = "压力角Af"
6 Y( Y2 e0 p; S0 d9 D        Me.Label4.Text = "轴径D4"
* `7 f  v, E8 D% u  n7 A6 A3 r        Me.Label5.Text = "齿宽B"
2 j+ ?$ D( `: H1 w; {, p        Me.Label6.Text = "D0"
0 Q; A4 o0 |3 Y8 m9 @' T% I        Me.Label7.Text = "D3"
0 _$ X$ s$ Y) O1 q( s3 T  u        Me.TextBox1.Text = 40
- s5 |+ L0 T$ C( C$ `        Me.TextBox2.Text = 6
" x9 W$ E! g7 _" c; e) V, s        Me.TextBox3.Text = 20
6 Q; a6 {8 ^7 C* \- }3 p        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
' ^7 a! U! j) R4 ?4 |3 ^: @        D4 = Val(Me.TextBox4.Text)
7 O7 Q: O5 h' r* K7 O        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
. T3 F4 C9 ^, ~        Me.TextBox7.Text = 1.6 * D4
        Me.CheckBox1.Text = "画腹板孔"
        Me.CheckBox1.Checked = True
& o. _$ l7 K7 `+ o7 w9 A# `        Me.Button1.Text = "齿轮结构造型"
        Me.Button2.Text = "结束"
    End Sub
    Sub 连接AutoCAD()
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
            Err.Clear()
1 I% m' c1 w. n3 j  F' Q5 p            AcadApp = CreateObject("AutoCAD.Application")
8 v" G9 m! @% |3 ^& v/ Y, m            If Err.Number Then
) e  }9 N: B1 ]8 V                MsgBox("不能运行AutoCAD，请检查是否安装了AutoCAD")
                Exit Sub
+ n$ w; K, M& c; K            End If
+ e4 \; Q) V9 ]7 h( b        End If
        AcadApp.Visible = True '界面可视
        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
4 E' `" d8 ]- A3 W& Z. L        AppActivate(AcadApp.Caption) '显示AutoCAD界面
# I+ ?  Z6 f" k' M: s5 M. s( H  ?    End Sub
    Sub 齿轮刀具()
        Dim R, Rf, Rb, Ra As Single
        R = m * Z / 2
        Rf = (R - 1.25 * m)
. _+ t! Z" p, z- k+ V! F        Rb = R * Cos(Af)
        Ra = R + m
% R$ P3 ]  u3 q! F$ o: V        Dim Sb, th(3)
, C5 _' k4 @% S' P. I. e        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
) ^) R5 O! e1 n9 ?8 l        th(0) = th(1) / 3
        th(2) = th(1) + Tan(Af) - Af
4 D1 B: B" Y1 }  H/ C        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
        Dim curves(5) As AutoCAD.AcadEntity
+ }: \- G! t2 U        Dim points0(5) As Double
        Dim points1(8) As Double
        Dim points2(5) As Double
+ E! [1 w5 S" o9 ?6 G        points0(0) = 0 : points0(1) = Rf
; _& o% p8 ^# O& x) ]        points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
" y  ]1 w( X7 z+ h        points0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
0 g: G9 B; q: I- s/ I        Dim startTan(2) As Double
" X4 [) }# h9 M) c" E, c        Dim endTan(2) As Double
2 T% ?% q: V/ o2 O        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
        points1(3) = R * Sin(th(2)) : points1(4) = R * Cos(th(2)) : points1(5) = 0
4 ?3 x6 T. \4 w) K- P$ q6 A        points1(6) = Ra * Sin(th(3)) : points1(7) = Ra * Cos(th(3)) : points1(8) = 0
) O' W- l8 ]) R        points2(0) = points1(6) : points2(1) = points1(7)
+ b. t) r" {* y( {5 g- n        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
; \: n: M8 U4 \- X        points2(4) = 0 : points2(5) = points2(3)
3 p. @/ i/ P8 l* }  O        If Rb < Rf Then
; p  e: {6 }' Q5 P4 s, L- a8 j+ A            points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03
            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
: @; Y2 S" X4 |6 g& _: U            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
        End If
% u' N+ o. X( L2 L5 c. K- i        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
5 ~  x; s9 B/ S        curves(0).SetBulge(1, 0.2)
        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
& H  ?/ u" |4 |; N7 T9 K9 J) H        Dim point1(2) As Double
/ k/ i8 n$ |# K5 D: N# \9 ~        Dim point2(2) As Double
        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
4 X3 x' e% M- @; b        point2(0) = 0 : point2(1) = 1 : point2(2) = 0
/ O9 m$ I7 @) y) b8 g7 n        curves(3) = curves(2).Mirror(point1, point2)
        curves(4) = curves(1).Mirror(point1, point2)
5 F" z, ^# ]/ \& k        curves(5) = curves(0).Mirror(point1, point2)
        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
$ r2 x2 q: T7 K" x% ~  U0 I        Dim taperAngle As Double
        taperAngle = 0
        Dim solidObj As AutoCAD.Acad3DSolid
( o6 I! d  |+ T* U1 s. g; v        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
3 g0 r( A+ ?/ E  k8 @3 p) o! t        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
* s2 ^3 x, e6 \8 i" S% G        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
& g' m. i8 y+ @8 o. L3 A    End Sub
4 o( V% o( J7 L. l0 B, _) r    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 = Val(Me.TextBox4.Text)
  l( Q6 G9 t: J: N        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
2 f1 t1 Z" t+ y2 k: v2 p0 s2 ~        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
        Me.TextBox7.Text = 1.6 * D4
; b, V2 T# q. ]% ]3 J; \    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
3 H) \. W2 {8 k4 \        Call 连接AutoCAD()
        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
1 x) Z5 k5 \; o& U! j! {3 c            entry.Delete()
3 \. B& b3 t: a
  R) E4 d* y! Z2 s2 r( R