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

圣歌

Imports System.Math
. Q8 |/ G9 f. f- c% O; i! b4 {4 T# QPublic Class Form1
5 H- d5 o- S' f1 a, O    Dim AcadApp As AutoCAD.AcadApplication
) d; I1 `8 I4 f! Z# F; j    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
    Dim Z, m, Af As Double
    Const Pi = 3.141592
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
$ r! Y1 `: j. m( E& F  O& [        Me.Text = "齿轮结构参数化三维造型"
& V! w; n+ J; u/ @$ C; E        Me.GroupBox1.Text = ""
3 d  Z# L! M0 G: c  W: L; q! }8 v        Me.Label1.Text = "齿数Z"
        Me.Label2.Text = "模数m"
        Me.Label3.Text = "压力角Af"
        Me.Label4.Text = "轴径D4"
        Me.Label5.Text = "齿宽B"
        Me.Label6.Text = "D0"
5 B% n; v: g) G& I1 L        Me.Label7.Text = "D3"
        Me.TextBox1.Text = 40
& C1 J" a1 I- D6 ^3 V        Me.TextBox2.Text = 6
/ g7 g6 F1 p9 t5 M9 _        Me.TextBox3.Text = 20
        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
0 n8 J: @- J& o; Q7 b. k5 K        D4 = Val(Me.TextBox4.Text)
- l7 z, B* G' A% K& l8 a        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
& @& o& X# S- h0 B# @8 H, y7 \        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
( D& V/ U3 l% @/ f2 d5 k        Me.TextBox7.Text = 1.6 * D4
        Me.CheckBox1.Text = "画腹板孔"
5 y7 n- J4 c7 Q9 s: G3 A        Me.CheckBox1.Checked = True
, a9 @0 s2 }7 c8 Z        Me.Button1.Text = "齿轮结构造型"
        Me.Button2.Text = "结束"
    End Sub
    Sub 连接AutoCAD()
7 `. B" T/ x$ b2 m6 c        On Error Resume Next
# Y+ Q5 q- j; |3 a3 d4 x        AcadApp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
            Err.Clear()
) v9 B2 E2 z2 S! s9 `9 Q3 J1 P  d            AcadApp = CreateObject("AutoCAD.Application")
            If Err.Number Then
2 L( l/ ^  I5 \+ [                MsgBox("不能运行AutoCAD，请检查是否安装了AutoCAD")
  G' D# x' p# M; h6 x( k                Exit Sub
9 x4 N# |3 {8 I- q5 I  v            End If
        End If
        AcadApp.Visible = True '界面可视
        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '显示AutoCAD界面
    End Sub
: o1 \/ x8 w& F2 O, a+ I; O/ H    Sub 齿轮刀具()
        Dim R, Rf, Rb, Ra As Single
2 P. s0 [9 q: A$ X2 ]+ t, m4 R        R = m * Z / 2
        Rf = (R - 1.25 * m)
        Rb = R * Cos(Af)
, b8 n, {2 K" f. C        Ra = R + m
        Dim Sb, th(3)
        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
6 N, j* g* i. X  `        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
        th(0) = th(1) / 3
( Y$ J0 Z" A! l; x" t        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
* [5 d; M" D- E% z5 [- U4 o  `        points0(0) = 0 : points0(1) = Rf
        points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
1 k$ I' O. ]3 n* j; Y        points0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
        Dim startTan(2) As Double
* ?0 i! P. a- T( x. n        Dim endTan(2) As Double
3 w* U$ {; P; C0 g6 n! q        startTan(0) = 0 : startTan(1) = 0 : startTan(2) = 0
' T9 p6 t' m8 Z. t- c5 j2 P! W& x" w8 w# ^        endTan(0) = 0.5 : endTan(1) = 0.5 : endTan(2) = 0
; O5 f2 W- k3 d# |8 U6 [4 c        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
+ o/ J, w8 C' I6 j) m& n        points1(6) = Ra * Sin(th(3)) : points1(7) = Ra * Cos(th(3)) : points1(8) = 0
        points2(0) = points1(6) : points2(1) = points1(7)
        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
' v- C( B' I* v! l% J' F- P        points2(4) = 0 : points2(5) = points2(3)
        If Rb < Rf Then
            points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03
' w) ?; G! L6 v            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
# a1 N, ?0 o7 b" g& H2 a0 @6 V        End If
        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
" n% a. m6 }% Y1 a1 g" ?0 s        curves(0).SetBulge(1, 0.2)
3 W; \" @9 Z+ D$ ^/ C5 g        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
( @4 r; I3 |2 c5 B        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
. E/ l) R( W5 Z; V; l: i        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)
7 \/ H4 N/ `1 s; o( q- a4 {( R+ k) W        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
: z4 A7 f! o7 i, _# T6 Q$ B& A1 U; x        Dim taperAngle As Double
. K* |/ E$ {9 f1 N1 Z: H, R0 C, [        taperAngle = 0
! M0 b5 v; L7 d) E        Dim solidObj As AutoCAD.Acad3DSolid
. ]& Y, }* Y6 r3 c        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
+ f' D- |; N2 U' V( w+ \+ M; i        Dim center(2) As Double
        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
        solidObj.Move(solidObj.Centroid, center)
) @' V' J: d) c0 `2 h+ {' D" f        Dim basePnt(2) As Double
' W, v; A. F  w: ]- ]$ Q        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
+ X0 n' W% c  G        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
9 C4 F- C3 Y& F$ |    End Sub
    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
/ \* Z; @0 H& @* m        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
0 v. z0 b6 c% F        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
1 s% c! h8 U3 A        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
; o2 P8 t+ `" h1 f! Z  O  M! ?        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
& T- O2 h8 w8 r        Me.TextBox7.Text = 1.6 * D4
    End Sub
5 G$ P" G( P. J4 J% `5 V    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
4 p/ g0 Z& c% C' {2 y            entry.Delete()

& B1 J) k3 F) r2 M; O