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

圣歌

Imports System.Math
Public Class Form1
    Dim AcadApp As AutoCAD.AcadApplication
+ a: J' o2 k  h7 r1 ]    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
- c! ]5 C0 k* `# }6 J! z    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
        Me.Text = "齒輪結構參數化三維造型"
        Me.GroupBox1.Text = ""
        Me.Label1.Text = "齒數Z"
2 H2 O" j. N5 Y- O3 y6 l! J        Me.Label2.Text = "模數m"
        Me.Label3.Text = "壓力角Af"
        Me.Label4.Text = "軸徑D4"
& w3 e, P8 Q5 W7 E% c$ s( o        Me.Label5.Text = "齒寬B"
6 x2 W1 \1 m' p* D4 M3 E        Me.Label6.Text = "D0"
        Me.Label7.Text = "D3"
4 ~& V5 L, u5 }: L- q  P; r# e( C        Me.TextBox1.Text = 40
        Me.TextBox2.Text = 6
' A) X( s  {* n, L: ~/ e        Me.TextBox3.Text = 20
8 n1 }: V) V- C; k2 t# ^        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
6 k( l5 D& |2 ^6 \5 N        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
  Q7 ^) C6 z* ~% R; S2 q: T        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
        Me.TextBox7.Text = 1.6 * D4
        Me.CheckBox1.Text = "畫腹板孔"
        Me.CheckBox1.Checked = True
        Me.Button1.Text = "齒輪結構造型"
# ~0 ^8 z) I/ ?1 l8 l0 }1 b        Me.Button2.Text = "結束"
5 F5 `7 R0 K( f9 z5 y    End Sub
) E" y% p+ Y) H' P" w& F. J    Sub 連接AutoCAD()
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
& t% K7 p. u$ m/ f) P0 Z% }            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
            If Err.Number Then
                MsgBox("不能運行AutoCAD，請檢查是否安裝了AutoCAD")
                Exit Sub
' D4 W4 C7 W9 l4 @0 M            End If
& \9 ]; M% ?$ [9 _7 d0 C4 V        End If
  w+ D+ q( B8 j5 q! Z        AcadApp.Visible = True '界面可視
. F( Y& M: y2 K8 i9 b- r' a        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '顯示AutoCAD界面
% z( n3 }/ r: o8 H6 }    End Sub
- B* `$ a3 C; M2 X: d" H( i! M8 s    Sub 齒輪刀具()
8 E( P! j- M5 G2 n  D) l) @3 A        Dim R, Rf, Rb, Ra As Single
+ G7 ~) O: V& E        R = m * Z / 2
7 U. k6 {4 ?. _0 ]- F, w- b( _        Rf = (R - 1.25 * m)
8 j# |3 @8 F& M; _        Rb = R * Cos(Af)
        Ra = R + m
; Y  K* s6 F( G* o: _/ N        Dim Sb, th(3)
7 v$ ?/ c2 }1 g* \        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
  q6 f% t8 d8 P1 }        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
        th(0) = th(1) / 3
( W$ x- y* Q! 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
        Dim points0(5) As Double
        Dim points1(8) As Double
        Dim points2(5) As Double
1 u# v" H6 b# \) W% L3 N" a        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))
# T2 Q( e5 f1 j7 Q        Dim startTan(2) As Double
' b8 q9 s5 _5 s& b        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
7 N4 e- N  ^/ @" W, \/ ^7 K        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
9 k" ?; j  [4 G' O# T        points1(6) = Ra * Sin(th(3)) : points1(7) = Ra * Cos(th(3)) : points1(8) = 0
) j! X7 V1 w# a2 z        points2(0) = points1(6) : points2(1) = points1(7)
. S& O% \: s& {; X# k( R( r, O8 H& \        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
1 V/ s# q0 G% |. s        points2(4) = 0 : points2(5) = points2(3)
        If Rb < Rf Then
: t) S; m/ ?! t3 Q            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
# p9 p; N. J5 J9 I9 x2 @            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
4 l: {$ s! _5 r2 w        End If
        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
, f6 S; F" R3 [' ~' V2 Q) ], b        curves(0).SetBulge(1, 0.2)
, m& l! M; s& Q- h" s- ?        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
, D+ A5 S  a" P! `1 c        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
2 A3 j: m1 W. f7 {* J        Dim point1(2) As Double
; O8 ^0 ]2 q4 ]6 M6 h/ O/ b6 f        Dim point2(2) As Double
8 t- u' {9 C: f0 f: a; [        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
  U' W8 L/ D6 |* @4 [        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)
' {# V( T: R: P: p( }! T, S# K        Dim taperAngle As Double
        taperAngle = 0
: @2 P- Y! k& |8 J% R% D# k( F        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
' r. s) h) o& N9 @) [; |- Q/ o        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
6 u0 R8 d* ]9 s: g  Z: @2 R        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
, F% T4 L2 ^  D( h        刀具 = 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
8 E" f/ N, n8 G' t; s9 S7 R8 J5 W        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
: t+ e9 ~9 n" t8 q$ Z2 y; ?        D4 = Val(Me.TextBox4.Text)
        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
* `; T6 r# Y" K' C. ]2 @; Q        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
, B" K' @9 c9 z3 B/ D% t        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
, i7 c  p3 ^9 A5 U$ N& t        Call 連接AutoCAD()
        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
7 w# A% {) U/ b' M$ a- d5 K$ C            entry.Delete()
) Z7 D) j8 L( h4 X: C( {! x
) u  ]5 ]# h! E& n3 p; W2 p