基于autocad的齒輪參數(shù)化源程序

圣歌

Imports System.Math
; ]/ B4 t# ~' b. n$ T. T6 KPublic Class Form1
    Dim AcadApp As AutoCAD.AcadApplication
    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
( u! k! y9 z8 C; y! c: ]  z8 _    Dim Z, m, Af As Double
( a- J! G0 X# M    Const Pi = 3.141592
7 Q8 r/ ]5 n2 ~    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "齒輪結(jié)構(gòu)參數(shù)化三維造型"
        Me.GroupBox1.Text = ""
( F4 w  w) N5 f! w- \9 s) m        Me.Label1.Text = "齒數(shù)Z"
        Me.Label2.Text = "模數(shù)m"
        Me.Label3.Text = "壓力角Af"
        Me.Label4.Text = "軸徑D4"
        Me.Label5.Text = "齒寬B"
, w! T2 g* e" q3 u& A        Me.Label6.Text = "D0"
        Me.Label7.Text = "D3"
        Me.TextBox1.Text = 40
6 `" s1 z6 X. \. \, P! k        Me.TextBox2.Text = 6
0 }" J, E) {% F5 ^/ l5 A+ C        Me.TextBox3.Text = 20
: x! h# I" n& y* o        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
$ E8 h+ l- p  `  A4 U        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
0 u7 i5 j0 H/ |: w( H4 T        Me.TextBox7.Text = 1.6 * D4
        Me.CheckBox1.Text = "畫腹板孔"
$ s* Q- }- I6 B0 E4 v; ^        Me.CheckBox1.Checked = True
        Me.Button1.Text = "齒輪結(jié)構(gòu)造型"
( z! O2 m  o, Z1 i/ L7 c        Me.Button2.Text = "結(jié)束"
    End Sub
4 r0 z0 C( o7 A8 i: }3 y    Sub 連接AutoCAD()
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
4 I2 y  h1 G2 S" y3 d1 l0 ?        If Err.Number Then
- H1 P: R% F/ i( a" }& V            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
+ \0 W. a2 F( J% h# F            If Err.Number Then
                MsgBox("不能運行AutoCAD，請檢查是否安裝了AutoCAD")
                Exit Sub
            End If
: R0 n$ ?* @7 e, h! |* ]. w        End If
/ p6 E8 g8 k& _" [# @        AcadApp.Visible = True '界面可視
% p. x8 X7 o& J1 \' P6 d  J        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
+ V1 B" B3 |% g        AppActivate(AcadApp.Caption) '顯示AutoCAD界面
    End Sub
    Sub 齒輪刀具()
        Dim R, Rf, Rb, Ra As Single
- i. f$ W/ g, Q$ v& ]        R = m * Z / 2
        Rf = (R - 1.25 * m)
" v( Q6 D) z& N7 e6 ]$ b        Rb = R * Cos(Af)
1 `6 K$ g# q( n. T  B' w        Ra = R + m
! |# S3 \9 u1 Z. L: W        Dim Sb, th(3)
! Y6 X9 i! ^! `* q        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
9 P8 X) Y3 @+ B' N, T3 V5 M+ m        th(2) = th(1) + Tan(Af) - Af
        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
        Dim curves(5) As AutoCAD.AcadEntity
4 L# V$ Q9 ~! D3 q5 E. h        Dim points0(5) As Double
        Dim points1(8) As Double
7 |% l- N( Q) h# Z# ]        Dim points2(5) As Double
5 J" t. z9 \; ?* R3 [3 d% n        points0(0) = 0 : points0(1) = Rf
( j3 ~; ~# K8 x& b9 I! L& A8 Z        points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
9 M2 K/ T$ {, l# i5 m: z        points0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
) ?9 w5 J' i9 h7 m1 j& T+ D        Dim startTan(2) As Double
; d: K: j9 t1 q; [9 a( V        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
1 \# o) c; f, `& J# O        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
        points1(6) = Ra * Sin(th(3)) : points1(7) = Ra * Cos(th(3)) : points1(8) = 0
4 u& E* ]- K' W. u        points2(0) = points1(6) : points2(1) = points1(7)
: i. I/ {- z4 R  G        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
        points2(4) = 0 : points2(5) = points2(3)
7 e: z  m6 i+ S( |) Z        If Rb < Rf Then
            points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03
; S/ M# V+ M& q5 w3 U" z9 ^: ~; ^& x            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
0 J5 M( E7 i* p2 [7 W# }            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
        End If
        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
        curves(0).SetBulge(1, 0.2)
! l6 ~2 S* q1 y( W8 g/ a9 q        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
0 F1 v6 T0 G: V% r        Dim point1(2) As Double
        Dim point2(2) As Double
4 i4 `  u/ V% a. T8 ]; E2 D* N        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)
' ~8 _3 Z5 d3 ?0 g% o/ ?2 Q        curves(4) = curves(1).Mirror(point1, point2)
2 A0 _; r+ L& \7 Q- K4 m- I' d        curves(5) = curves(0).Mirror(point1, point2)
        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
3 ~) Y) y. |8 V1 |1 ~; O! S        Dim taperAngle As Double
        taperAngle = 0
; {3 {6 X3 q& F$ X* x4 `        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
/ n, V! ?+ C0 i" Y        Dim center(2) As Double
* U: f' Y4 \; u: D! y        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#
. Z6 a" @7 f0 @! d; i6 g        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
' y! D6 i( v2 L+ [/ A8 _5 E    End Sub
' T* K" y5 R- i4 Y- l+ o7 e    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
  w0 R6 t- K( N; f. B        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
( b- N# ~# n$ L+ g: H3 P5 P        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
; u/ q1 Q. i% i) T1 g6 l( r6 q7 g        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
7 b3 T4 U* j- Q$ }+ Q* u        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
        Me.TextBox7.Text = 1.6 * D4
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Call 連接AutoCAD()
6 }/ S, j/ I" Q6 _0 B  V        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
, ~, P8 |8 K% Q2 o! q            entry.Delete()