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

圣歌

Imports System.Math
, b/ b& k/ @; J) u2 L0 A" p; Z4 jPublic Class Form1
- c4 t" j4 j8 R  t2 V1 O( M    Dim AcadApp As AutoCAD.AcadApplication
    Dim 刀具 As Object
- O3 `5 x$ T/ t2 d1 P+ k2 E    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
7 Z* V' W( R: @) [8 y) X    Dim Z, m, Af As Double
0 |/ Q1 U  A9 a2 Z/ m  F" E. N    Const Pi = 3.141592
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Text = "齒輪結(jié)構(gòu)參數(shù)化三維造型"
        Me.GroupBox1.Text = ""
        Me.Label1.Text = "齒數(shù)Z"
        Me.Label2.Text = "模數(shù)m"
4 s5 s! j4 [9 ]- k4 H/ `        Me.Label3.Text = "壓力角Af"
        Me.Label4.Text = "軸徑D4"
6 _3 |) W0 v9 d+ m. |        Me.Label5.Text = "齒寬B"
        Me.Label6.Text = "D0"
        Me.Label7.Text = "D3"
        Me.TextBox1.Text = 40
        Me.TextBox2.Text = 6
3 g9 p& {. n# `$ @        Me.TextBox3.Text = 20
" [. S& v7 ~$ ^' M        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
: k3 B0 k4 N; h& T/ E4 T; G* U        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)
7 M8 b/ g. N) L! ^% X        Me.TextBox7.Text = 1.6 * D4
+ E2 `  Y; G6 R% \2 x$ L        Me.CheckBox1.Text = "畫腹板孔"
        Me.CheckBox1.Checked = True
" p4 J8 q' b  l* u  A+ z" E        Me.Button1.Text = "齒輪結(jié)構(gòu)造型"
        Me.Button2.Text = "結(jié)束"
6 T1 i% E2 x# V: V) f$ N6 P% x3 B    End Sub
    Sub 連接AutoCAD()
        On Error Resume Next
, V5 }5 U" u1 s5 _& o        AcadApp = GetObject(, "AutoCAD.Application")
        If Err.Number Then
            Err.Clear()
            AcadApp = CreateObject("AutoCAD.Application")
5 ]/ m+ R; z6 u- q; s            If Err.Number Then
# @3 f- i% R4 A# p                MsgBox("不能運行AutoCAD,，請檢查是否安裝了AutoCAD")
$ `% |- N; d, v7 O  j. c6 T: x                Exit Sub
            End If
( f' r$ `' s* o! g7 J5 d/ U! w. r        End If
        AcadApp.Visible = True '界面可視
( \' L# v: S7 p0 V: U4 x2 t, B        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '顯示AutoCAD界面
    End Sub
' o0 `( R2 D; L1 G: v- R- f$ f! F    Sub 齒輪刀具()
        Dim R, Rf, Rb, Ra As Single
        R = m * Z / 2
        Rf = (R - 1.25 * m)
        Rb = R * Cos(Af)
        Ra = R + m
0 d1 B- c; Y3 U# D        Dim Sb, th(3)
        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
& a! M$ J7 g+ X2 V% Z        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
        th(0) = th(1) / 3
! ]. O2 l  _) l% B        th(2) = th(1) + Tan(Af) - Af
2 d0 A) Y; u! t+ ^0 [# K+ a        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
; h' N& v' _1 z' t; D" |        Dim curves(5) As AutoCAD.AcadEntity
3 z, D' e; ?) J  z5 g4 @        Dim points0(5) As Double
        Dim points1(8) As Double
        Dim points2(5) As Double
6 j  s( H' O9 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))
: f" S$ `' G# N+ q1 z/ ^) L) i1 N        Dim startTan(2) As Double
2 h; I! h/ ~- b4 K/ i7 I% O5 d        Dim endTan(2) As Double
* o4 x5 X; O, @) n4 Y. o8 T: I        startTan(0) = 0 : startTan(1) = 0 : startTan(2) = 0
/ C* A  F- K! c8 v7 P7 k# _) g        endTan(0) = 0.5 : endTan(1) = 0.5 : endTan(2) = 0
3 b8 O- V3 D5 v! e0 h* s5 c        points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
1 R: X/ F) M+ Y" j& i* m        points1(3) = R * Sin(th(2)) : points1(4) = R * Cos(th(2)) : points1(5) = 0
3 V6 P5 p$ K% d        points1(6) = Ra * Sin(th(3)) : points1(7) = Ra * Cos(th(3)) : points1(8) = 0
        points2(0) = points1(6) : points2(1) = points1(7)
$ h" D* k! _& g) o/ V0 u        points2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
9 B- O- s. K9 ~6 C; o. T1 u        points2(4) = 0 : points2(5) = points2(3)
        If Rb < Rf Then
" `( J" S2 d7 ]" D# }+ S            points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03
1 ~& W, o2 a* R; x7 {            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
' g7 X/ B% G( P/ e5 m            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
1 c. u# t9 c" j- B8 C0 j' T        End If
1 g# {! Y$ M# V6 v! _$ r        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
) R) _, [6 ~3 q; [& N) d6 ~8 r' A  q        curves(0).SetBulge(1, 0.2)
        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
' _, `; ^2 P1 v+ _% @  Y        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
        Dim point1(2) As Double
' m5 F/ b8 W- z- g* u& t. N1 o        Dim point2(2) As Double
0 ^% \, p) N. n9 _        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
: G; d4 V# R2 d  c. h. U        point2(0) = 0 : point2(1) = 1 : point2(2) = 0
3 i! h: d2 w7 q9 h1 ?* Z        curves(3) = curves(2).Mirror(point1, point2)
        curves(4) = curves(1).Mirror(point1, point2)
  `( b2 Z% z2 z% r3 @        curves(5) = curves(0).Mirror(point1, point2)
2 G' K" S' B7 l- O' ^+ M        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
        Dim taperAngle As Double
        taperAngle = 0
        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
+ _# q) A& Z  }5 U) ]# k        Dim center(2) As Double
7 E5 f! \! {! @1 t! y0 j; E        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
        solidObj.Move(solidObj.Centroid, center)
1 v/ F$ i, f" @* L# ~4 c        Dim basePnt(2) As Double
& O- f: U3 }& ^7 W! j9 |: Q        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
$ d' `1 o4 z$ S) W+ \8 y        刀具 = 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
) r7 H3 h. M9 s4 c6 f" [2 s        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
  c# E7 {$ @: N        D4 = Val(Me.TextBox4.Text)
        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
3 L. W8 q0 O3 L5 Z2 d    End Sub
* t, q. o! R( ~    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Call 連接AutoCAD()
7 X3 r; G8 g9 L) Y# P        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
! y) o1 Y8 D& |" U* I  S8 ?            entry.Delete()

5 p+ l$ ?0 z8 r$ o  w; W" a/ I3 N  ^