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

圣歌

Imports System.Math
  T. C# E! ^0 ?- EPublic Class Form1
    Dim AcadApp As AutoCAD.AcadApplication
    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
  s, w' l* S% w# m( y9 t" X    Dim Z, m, Af As Double
* |# h1 L9 n6 y+ ]    Const Pi = 3.141592
$ V2 a( ]  W1 x1 s5 j( X1 ^5 {( Z    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
& [4 N( X5 k' q& y* v9 S0 r        Me.Text = "齒輪結(jié)構(gòu)參數(shù)化三維造型"
0 f" W) _. Q* e- W" P$ o' `8 x        Me.GroupBox1.Text = ""
        Me.Label1.Text = "齒數(shù)Z"
1 `: Y+ O7 n* k1 G# l# F        Me.Label2.Text = "模數(shù)m"
        Me.Label3.Text = "壓力角Af"
        Me.Label4.Text = "軸徑D4"
$ j9 K$ o( G, ]/ H        Me.Label5.Text = "齒寬B"
7 c; z8 p3 ?0 ^& v/ J: M/ ^8 l        Me.Label6.Text = "D0"
% S5 Z0 `9 J7 g/ [        Me.Label7.Text = "D3"
        Me.TextBox1.Text = 40
$ r: l7 v" \! D6 c        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)
" _& B# _' d, ]* U) n, N6 p        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
! Q1 j" X; Q) C- B3 r, g3 U) ^        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
3 E+ `; }  h8 D0 ?$ ?        Me.TextBox7.Text = 1.6 * D4
        Me.CheckBox1.Text = "畫腹板孔"
; y1 N# v$ Q6 ?5 U; T' |9 m" S, i        Me.CheckBox1.Checked = True
* d; n! W6 u6 {        Me.Button1.Text = "齒輪結(jié)構(gòu)造型"
        Me.Button2.Text = "結(jié)束"
# T& t$ q# b( O, u- u    End Sub
    Sub 連接AutoCAD()
# F! C" `4 P! p& q) D) m* Z        On Error Resume Next
) q: a  L# e+ \4 y& Y& N  r        AcadApp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
- E3 h0 _$ r& ^            If Err.Number Then
  ]3 }$ k" Y( Y% h7 A/ y/ F                MsgBox("不能運(yùn)行AutoCAD，請(qǐng)檢查是否安裝了AutoCAD")
3 \2 I5 f. _- W( w* S2 z                Exit Sub
- L: S# M8 o# A) h2 C- `' H" g            End If
# ]2 K4 _, `) p9 X        End If
- V4 q) Y7 ?: C9 A7 h$ U        AcadApp.Visible = True '界面可視
2 |2 g* y. r6 `, V" u        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '顯示AutoCAD界面
( x8 G2 b# o) q    End Sub
1 w. d; c8 r! g; L& O: N4 r    Sub 齒輪刀具()
2 p3 Y3 E7 R1 k) j5 k        Dim R, Rf, Rb, Ra As Single
        R = m * Z / 2
- R" \9 Y! L7 ]+ E& R        Rf = (R - 1.25 * m)
1 \% ?6 V0 @) I& ]        Rb = R * Cos(Af)
        Ra = R + m
        Dim Sb, th(3)
5 {+ d2 D. M5 E        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
. {: R% w, g& E" _- o        th(2) = th(1) + Tan(Af) - Af
        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
. h' s6 ~# F7 E9 N4 V- ]        Dim curves(5) As AutoCAD.AcadEntity
; m" ?) R% _/ u0 @        Dim points0(5) As Double
        Dim points1(8) As Double
' n# e9 l& q1 [9 f        Dim points2(5) As Double
        points0(0) = 0 : points0(1) = Rf
  m1 ?. W  x  F5 Y        points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
( k0 K& a" c! L" E% E/ z        points0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
8 n" ]6 a  F+ [/ S) U' {        Dim startTan(2) As Double
! I* `- V9 ?" W  f8 W& w* N        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
        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
        points2(0) = points1(6) : points2(1) = points1(7)
# I# |# e6 F" Z, [9 e% J        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
/ D* ?1 d4 `; X, D8 h# l; H        points2(4) = 0 : points2(5) = points2(3)
* \3 E$ w  j' p9 g4 U3 y        If Rb < Rf Then
            points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03
8 M1 L9 j6 _6 a9 B7 c            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
2 Y+ J0 |/ `1 |- ~            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
2 V. h$ s% E0 J$ B& o1 s        End If
" |, X& e4 m; k- S; b3 P3 I, ]# S) E        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
; d0 A6 ]8 s$ j2 E7 m        curves(0).SetBulge(1, 0.2)
2 B+ j/ E/ |" t- f1 c        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
  x, W- f: h! p/ N# @. M        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
4 ^. t( a* ~0 u9 G3 e9 u: z5 e+ H        Dim point1(2) As Double
& L: A) x/ Y5 C3 R1 u. Y        Dim point2(2) As Double
0 s. U6 O4 p2 i: U5 {  L$ L6 n        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
% Z2 j, G5 G/ @: @( ?        point2(0) = 0 : point2(1) = 1 : point2(2) = 0
        curves(3) = curves(2).Mirror(point1, point2)
        curves(4) = curves(1).Mirror(point1, point2)
3 U5 I  o% n0 p% j0 N# \        curves(5) = curves(0).Mirror(point1, point2)
! j; n; `% R5 Z* ?0 S        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
5 X$ Y& ]1 k- D! O  |1 w7 U1 Q        Dim taperAngle As Double
. N7 ~0 y* }% W. @7 O; F        taperAngle = 0
        Dim solidObj As AutoCAD.Acad3DSolid
6 J) x+ Z; {: P3 _( D        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
        Dim center(2) As Double
1 U, j2 j+ v: T$ Q2 Z1 q# D        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
        solidObj.Move(solidObj.Centroid, center)
$ f8 v9 u- m' ]5 s1 ^# U        Dim basePnt(2) As Double
        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
  J& s, c* R( R: r    End Sub
    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
: X* P+ e; c( r: \8 o, q5 P        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
/ q# ~$ s0 R) s  f8 n2 U        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
9 ^  }0 M; Y$ F: [# R, K, H5 o        Me.TextBox7.Text = 1.6 * D4
    End Sub
( ]3 A2 Z' G( k    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Call 連接AutoCAD()
- U; a2 k- q; N2 K/ u        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
            entry.Delete()
7 e, W% `4 K2 _) V/ m