基于autocad的齒輪參數化源程序

圣歌

Imports System.Math
2 |! q8 h8 ~" N2 dPublic Class Form1
+ Z* L7 j3 Q$ W- P! A. s2 c    Dim AcadApp As AutoCAD.AcadApplication
" o- b4 g. j, c1 x$ e! m, j, o& z    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
    Dim Z, m, Af As Double
2 X9 i8 b% N: ~: S  f    Const Pi = 3.141592
- E& o  T- q1 k* ~" P* \  b    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "齒輪結構參數化三維造型"
* ^$ `( N. X, s) w2 }2 Q        Me.GroupBox1.Text = ""
        Me.Label1.Text = "齒數Z"
- o2 Q& @% b0 O7 h" @2 g/ n( k        Me.Label2.Text = "模數m"
( `$ H: v, J% f# z: v, `0 p        Me.Label3.Text = "壓力角Af"
        Me.Label4.Text = "軸徑D4"
        Me.Label5.Text = "齒寬B"
        Me.Label6.Text = "D0"
0 b" \3 R  n3 E        Me.Label7.Text = "D3"
& J0 t* ?3 x' C  T0 y0 \        Me.TextBox1.Text = 40
2 o3 c% X# Z. P7 E5 u- b        Me.TextBox2.Text = 6
        Me.TextBox3.Text = 20
5 O6 M' n9 Q  a; u' D        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
* q3 X$ K8 p7 U0 u8 o        D4 = Val(Me.TextBox4.Text)
        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
" f: V' S( @, ]- c: b0 {: S        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
9 Z; i. ~5 N; |7 ]        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
: k" f2 \# Z1 ]" x/ ~        Me.TextBox7.Text = 1.6 * D4
        Me.CheckBox1.Text = "畫腹板孔"
4 {9 E7 s1 q" G3 z0 d2 T        Me.CheckBox1.Checked = True
7 p5 T. M3 B9 `        Me.Button1.Text = "齒輪結構造型"
' ^$ y' o0 l' W  E        Me.Button2.Text = "結束"
: }! T& I5 r9 Y: |4 |; r    End Sub
+ T- {6 p2 e- x7 e2 e! ?    Sub 連接AutoCAD()
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
/ q1 }2 e/ J& j7 h; I$ T. \        If Err.Number Then
- i  V0 s4 f! C+ r            Err.Clear()
3 u4 l5 g5 Q. _$ h+ G! _' `! C            AcadApp = CreateObject("AutoCAD.Application")
" C4 ?# n; h+ N1 q3 z/ }            If Err.Number Then
                MsgBox("不能運行AutoCAD，請檢查是否安裝了AutoCAD")
( m* w' E% @* q# @                Exit Sub
4 v+ Y* a* ~: f; U% |6 V5 o, _            End If
& K3 X3 Z# F# J; |: h. i4 S5 m        End If
        AcadApp.Visible = True '界面可視
' f) S+ ]( l0 C% ^4 m/ e; @        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '顯示AutoCAD界面
9 |" E# M, f0 U    End Sub
; |6 w! o1 s* V& J2 [3 |    Sub 齒輪刀具()
; V& N, V+ j8 j) L; g        Dim R, Rf, Rb, Ra As Single
1 `* `1 T, e- K: O( a  T        R = m * Z / 2
        Rf = (R - 1.25 * m)
        Rb = R * Cos(Af)
        Ra = R + m
6 x" V% }/ c. G/ ?        Dim Sb, th(3)
  u+ E) V; X' a5 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 ~3 e6 C. a. Y/ E& u( L' u        th(2) = th(1) + Tan(Af) - Af
7 r; u  a7 i! {4 m- r; O        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
9 [2 w: J- Z4 N1 I        Dim curves(5) As AutoCAD.AcadEntity
        Dim points0(5) As Double
: e! d# b8 h" c7 z0 `        Dim points1(8) As Double
( @0 S4 S1 l! e( l! L- K: l$ H* Z3 [        Dim points2(5) As Double
3 ~) o, p6 |5 S* Q( Q. V4 Z) ]: {        points0(0) = 0 : points0(1) = Rf
        points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
        points0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
        Dim startTan(2) As Double
        Dim endTan(2) As Double
0 R& e+ T2 `7 O5 l9 H/ \, Z; Z        startTan(0) = 0 : startTan(1) = 0 : startTan(2) = 0
6 j& F( |2 A7 E% h- `4 y0 @4 H( A        endTan(0) = 0.5 : endTan(1) = 0.5 : endTan(2) = 0
4 \6 H' ~2 P$ ?& A0 _        points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
8 I; P( o) ?) K9 h  Y* g+ t        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
        points2(0) = points1(6) : points2(1) = points1(7)
        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
  u- ^6 p# `7 T+ r5 v9 ~+ `        points2(4) = 0 : points2(5) = points2(3)
        If Rb < Rf Then
) A  {. O8 t: m            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
1 B; ^% Y+ l6 T            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
) N, v6 J) \- B8 r1 R" d! b        End If
7 }, h9 u) h# e5 U( j4 l        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
% }+ v. m! o0 |! e3 {        curves(0).SetBulge(1, 0.2)
0 q/ e; H6 C. J& b: U        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
  O4 X! C0 s2 n6 T        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
: u& o& r3 f. t" R8 P  n0 w; l- x        Dim point1(2) As Double
        Dim point2(2) As Double
        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
2 ^5 r$ l+ r/ `% g6 e7 M        point2(0) = 0 : point2(1) = 1 : point2(2) = 0
        curves(3) = curves(2).Mirror(point1, point2)
        curves(4) = curves(1).Mirror(point1, point2)
( K' j& P# w1 K8 r        curves(5) = curves(0).Mirror(point1, point2)
& X$ X+ `$ a' q9 d8 u        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
        Dim taperAngle As Double
        taperAngle = 0
; v, q# o, l% t3 t6 \0 I        Dim solidObj As AutoCAD.Acad3DSolid
* o: T- y* a- h0 m$ T* V8 Q1 ^: g# K        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
, \! g4 v, `: m9 l        Dim center(2) As Double
        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
, T1 P  p- y! |, V6 s        solidObj.Move(solidObj.Centroid, center)
        Dim basePnt(2) As Double
        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
/ c3 p2 w$ G- |        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
; a  n, b" b' R* {8 Q    End Sub
    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
. p. L1 \) G  g& y8 g0 O% N2 {        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
) E) g. @! c2 l3 z        D4 = Val(Me.TextBox4.Text)
        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
: t( {2 K% h% n6 o5 j        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
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
2 k6 J: V. G) v. E6 k" u; x        Call 連接AutoCAD()
& U. x2 Y9 m# p# R; `8 a1 a7 f        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
            entry.Delete()
  {5 S; r0 }% ]% u