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

圣歌

Imports System.Math
Public Class Form1
    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
    Const Pi = 3.141592
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "齒輪結構參數化三維造型"
0 a* y3 h/ j6 S; o7 b        Me.GroupBox1.Text = ""
        Me.Label1.Text = "齒數Z"
        Me.Label2.Text = "模數m"
/ e& r2 n5 U6 q0 d% t7 C0 W& s        Me.Label3.Text = "壓力角Af"
! n6 t3 _0 h3 r) r9 G        Me.Label4.Text = "軸徑D4"
2 z  M( X" I2 `0 R0 l        Me.Label5.Text = "齒寬B"
        Me.Label6.Text = "D0"
2 O5 [  Y/ [3 H+ I1 l" o& o        Me.Label7.Text = "D3"
) v  ^0 }4 ?( {: m9 Y0 q5 m2 o" p) }, j        Me.TextBox1.Text = 40
        Me.TextBox2.Text = 6
7 ^/ D8 a" M( N- e: c        Me.TextBox3.Text = 20
2 e# B: R' C" @        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
  W) p% k2 p) U/ `6 d        D4 = Val(Me.TextBox4.Text)
9 ?0 r9 \. F' _( i! ~% I        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
        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
/ z- H7 x' L0 Y" H6 X        Me.CheckBox1.Text = "畫腹板孔"
8 L0 Y3 p; [- S" |; L4 t8 C        Me.CheckBox1.Checked = True
        Me.Button1.Text = "齒輪結構造型"
        Me.Button2.Text = "結束"
& \+ i- a- F% R% F    End Sub
$ m/ d3 A9 N1 b; |$ \    Sub 連接AutoCAD()
2 ^2 V- O9 K$ h6 p4 Z2 ^        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
: ~+ |, }5 S+ S$ A8 }        If Err.Number Then
            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
            If Err.Number Then
9 O1 e) P& U8 s5 N. V; \                MsgBox("不能運行AutoCAD，請檢查是否安裝了AutoCAD")
. F; r. ?: \( {2 d& T" }8 d5 y2 z                Exit Sub
            End If
        End If
        AcadApp.Visible = True '界面可視
0 @: v+ d9 E9 m# F        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
" g, r! F1 W  F; K. Z2 B; u3 z        AppActivate(AcadApp.Caption) '顯示AutoCAD界面
    End Sub
2 \! Y7 e' V: y8 H3 r/ i, m: a! q3 U    Sub 齒輪刀具()
5 R" d, D( z% [2 {% C        Dim R, Rf, Rb, Ra As Single
0 I$ {. t7 {0 C- F! y9 L* j        R = m * Z / 2
& ?! W1 V( Z% U7 ]2 N        Rf = (R - 1.25 * m)
        Rb = R * Cos(Af)
        Ra = R + m
        Dim Sb, th(3)
1 ?; J* X0 R4 m& R        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
8 I, T; c2 G' I( S" }; t, k        th(0) = th(1) / 3
        th(2) = th(1) + Tan(Af) - Af
$ B' C* G1 P+ r( @: s        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
: Z: _; U; ^* n1 J        points0(0) = 0 : points0(1) = Rf
0 }8 ]7 y3 W" s" e: K        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
8 P9 A$ b! L5 J0 [( s4 g& D3 |; h5 G. {        Dim endTan(2) As Double
        startTan(0) = 0 : startTan(1) = 0 : startTan(2) = 0
8 g  E- S& b7 P8 Z' U        endTan(0) = 0.5 : endTan(1) = 0.5 : endTan(2) = 0
        points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
8 k4 B* b4 ~5 I/ W        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
- w5 ?7 i: I9 O) m        points2(4) = 0 : points2(5) = points2(3)
. t9 Q% W+ @, K" e. c' g; c9 }        If Rb < Rf Then
, {3 f; w+ K8 y- a            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
            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
        End If
        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
0 ?% y! s, [- n% v8 \        curves(0).SetBulge(1, 0.2)
        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
1 t' V, d' v0 B% J* t8 Q, U- {        Dim point1(2) As Double
5 S% V1 |7 [. o( u% H" M        Dim point2(2) As Double
- Y5 M8 W5 @5 n3 x5 H  w3 Q        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)
, j0 I" I% \0 N' f3 c) Y  V' Q        curves(4) = curves(1).Mirror(point1, point2)
        curves(5) = curves(0).Mirror(point1, point2)
        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
        Dim taperAngle As Double
        taperAngle = 0
9 M! ~( t/ i) Q: L        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
        Dim center(2) As Double
" \) i, m8 w+ ^) l! s        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
: {$ y$ F2 U0 A" _( b' K. e% ^. I        solidObj.Move(solidObj.Centroid, center)
3 X, E3 Z( E1 l( j. [9 t" w4 @        Dim basePnt(2) As Double
, _2 o4 ]* m1 N! `' R        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
    End Sub
& b0 k0 E0 u/ c. h% g3 f    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
) ?1 a5 ~0 {/ |& N+ f! T        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
+ \" x+ `6 j$ k+ M% G        D4 = Val(Me.TextBox4.Text)
        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
2 r! l' b9 N/ P& z) @! |5 b& A        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
0 `: ^; @3 O" X# _5 S; u, _# z        Me.TextBox7.Text = 1.6 * D4
; @- v$ V% m2 \" p2 t    End Sub
& T! D$ A5 W9 x" i    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
            entry.Delete()
8 t  i/ H, z6 e3 {  e
9 Z0 z. m; q' M- Y