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

圣歌

Imports System.Math
- R5 r) r4 b1 Z+ Q, EPublic Class Form1
8 Y( `7 I6 M( d/ U  T; J* u0 L    Dim AcadApp As AutoCAD.AcadApplication
    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
    Dim Z, m, Af As Double
+ z8 }) R1 q6 i  a6 u    Const Pi = 3.141592
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "齒輪結構參數化三維造型"
" W) m" i* r* Y2 O        Me.GroupBox1.Text = ""
3 j. Q7 E8 _* o8 z7 [' _9 q5 ~        Me.Label1.Text = "齒數Z"
        Me.Label2.Text = "模數m"
        Me.Label3.Text = "壓力角Af"
5 L% q+ c3 w# O2 U        Me.Label4.Text = "軸徑D4"
% K6 P4 {7 d/ V* L        Me.Label5.Text = "齒寬B"
9 r7 D8 ]! a" b; [& J' |        Me.Label6.Text = "D0"
3 g# p3 D, Y# ?6 O        Me.Label7.Text = "D3"
        Me.TextBox1.Text = 40
        Me.TextBox2.Text = 6
        Me.TextBox3.Text = 20
        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
. g3 _- u3 l/ W+ A! q        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
. ?# Z! l. q& m, B. b        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
# f: \7 T* u, G; K% z7 i) F4 o        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
% n% R5 L* n2 C' M$ y+ c        Me.TextBox7.Text = 1.6 * D4
        Me.CheckBox1.Text = "畫腹板孔"
        Me.CheckBox1.Checked = True
        Me.Button1.Text = "齒輪結構造型"
3 Y0 d2 {. I8 S2 }9 L' t3 @        Me.Button2.Text = "結束"
) _( F4 A4 K# i+ P, R6 |" O5 D  @    End Sub
    Sub 連接AutoCAD()
) D/ @1 Y5 W  ]' x- R/ C/ B        On Error Resume Next
" d) l" \: m1 g# n        AcadApp = GetObject(, "AutoCAD.Application")
+ L7 N. _4 C0 l* O8 Q/ T- ]        If Err.Number Then
            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
            If Err.Number Then
3 d$ x3 X; C0 x/ ^* ]! k+ L# Z( n2 [' H                MsgBox("不能運行AutoCAD，請檢查是否安裝了AutoCAD")
- u/ @# v0 S* z( A+ N! F& @                Exit Sub
; G. C9 s! v, T, J) }            End If
        End If
9 o( _+ Q" H" H$ b        AcadApp.Visible = True '界面可視
$ a) D. [# J& a        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '顯示AutoCAD界面
    End Sub
    Sub 齒輪刀具()
        Dim R, Rf, Rb, Ra As Single
& m6 I  u6 T, f        R = m * Z / 2
! b+ v; _# ^6 \; b/ c        Rf = (R - 1.25 * m)
        Rb = R * Cos(Af)
" j  c- j3 `& r& s6 ^5 W  i        Ra = R + m
        Dim Sb, th(3)
, H6 @( ]* d: B! h* C7 i        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
5 K' B: ~2 i, Z! d        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
        th(0) = th(1) / 3
        th(2) = th(1) + Tan(Af) - Af
7 y9 v9 W" c( D        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
        Dim curves(5) As AutoCAD.AcadEntity
5 C. @, `$ e% S8 H; y4 ]        Dim points0(5) As Double
+ {" `5 p6 ]* t+ O; D( C        Dim points1(8) As Double
! m& J2 e5 a3 P: j        Dim points2(5) As Double
        points0(0) = 0 : points0(1) = Rf
# D! ]* E% ]1 @! f# @% p$ t        points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
$ ^/ c" S- I8 I% ]" L        points0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
9 Y- J8 g% @' Y$ m, ]$ a        Dim startTan(2) As Double
        Dim endTan(2) As Double
        startTan(0) = 0 : startTan(1) = 0 : startTan(2) = 0
1 O: P2 X/ D/ |  h        endTan(0) = 0.5 : endTan(1) = 0.5 : endTan(2) = 0
8 X3 |2 s2 Y' K  m5 v, U        points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
) |' v3 k: a0 ?$ o        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)
' P8 ?. q0 \, ]' v1 ?, Z% j% m        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
        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
  v3 U* \1 J: G) S5 U            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
/ w7 _0 F6 p! R8 v            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
        End If
) H% d) Z, x; i1 l: {' v        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
7 I3 J$ i3 E# s  r4 \        curves(0).SetBulge(1, 0.2)
) n% S% g  g0 E        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
0 _8 T- G( V) K- h" d/ H+ }        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
0 S+ L2 e3 f7 t        Dim point1(2) As Double
        Dim point2(2) As Double
, O- |1 ~1 q1 K: N2 I$ u8 J9 R- p        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
        point2(0) = 0 : point2(1) = 1 : point2(2) = 0
# |+ [4 W2 j5 m        curves(3) = curves(2).Mirror(point1, point2)
' a# Y- N7 i, C$ K& P, {        curves(4) = curves(1).Mirror(point1, point2)
        curves(5) = curves(0).Mirror(point1, point2)
  R1 }0 O+ K* y  X& E: O  W$ ^, ^        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
        Dim taperAngle As Double
: G! a$ n2 J9 a" m2 e6 C, g        taperAngle = 0
        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
1 L& A8 R& M! D  G/ m        Dim center(2) As Double
        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
- z8 w! h! F9 S9 i; \/ T. h) S( R        solidObj.Move(solidObj.Centroid, center)
  j6 ^7 h: B2 b% U+ B! ~        Dim basePnt(2) As Double
3 H, a$ h3 g6 q+ }0 v        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
0 s2 V4 v$ O" q  t; n/ [$ P, g    End Sub
    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
* U7 P& d& J( ~7 Z9 {/ }+ ]        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
4 n/ M! r" C# P3 L5 w0 i        D4 = Val(Me.TextBox4.Text)
        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
0 F( ~* t  Q! X% y, 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
0 d& b$ D% d# k& \/ ]        Call 連接AutoCAD()
        Dim entry As AutoCAD.AcadEntity
  z% B+ }0 d3 g8 q% D4 ?        For Each entry In AcadApp.ActiveDocument.ModelSpace
            entry.Delete()
5 ~0 Z- W3 B$ r, Y7 ~
3 V9 \8 X7 [% n' W: ]9 n8 j