基于autocad的齿轮参数化源程序

圣歌

Imports System.Math
Public Class Form1
6 P" s3 q1 A4 _) {    Dim AcadApp As AutoCAD.AcadApplication
    Dim 刀具 As Object
    Dim Da, D0, D1, D2, D3, D4, n1, B, C As Double
' x, G+ N9 q9 W" n! g. F" C    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 = "齿轮结构参数化三维造型"
# V) ?; t% ~. g. z, {0 h3 V1 h        Me.GroupBox1.Text = ""
        Me.Label1.Text = "齿数Z"
( h7 J* S1 H( i4 u7 a        Me.Label2.Text = "模数m"
# @: l" ]# y  R        Me.Label3.Text = "压力角Af"
        Me.Label4.Text = "轴径D4"
        Me.Label5.Text = "齿宽B"
$ K8 @/ e$ \" t% @' l        Me.Label6.Text = "D0"
        Me.Label7.Text = "D3"
9 _5 i% _9 v' x- m) Q1 z0 e' }0 z0 i# l        Me.TextBox1.Text = 40
! F0 U- m% S1 u9 e* \* r, W        Me.TextBox2.Text = 6
! N8 B! m. \) u! v( |3 Z        Me.TextBox3.Text = 20
        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
        D4 = Val(Me.TextBox4.Text)
4 o' q6 k+ J9 A, S! w6 S& x        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
- ~! n+ |  A- t. V$ w& b        Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
" o7 d( g. @. q" u& Y        Me.TextBox7.Text = 1.6 * D4
& b3 f3 h- c3 V9 y& M' Y6 {2 g        Me.CheckBox1.Text = "画腹板孔"
/ C8 }! _) \7 E: a. ]6 t  [, ^        Me.CheckBox1.Checked = True
        Me.Button1.Text = "齿轮结构造型"
        Me.Button2.Text = "结束"
  `# j3 X* W" ]. c    End Sub
    Sub 连接AutoCAD()
        On Error Resume Next
        AcadApp = GetObject(, "AutoCAD.Application")
9 \; n1 Z& F2 U+ _6 L* |- {        If Err.Number Then
            Err.Clear()
  i& Q# E* U; x# `            AcadApp = CreateObject("AutoCAD.Application")
            If Err.Number Then
! M* T* [7 G- u8 i1 X$ g, S2 g                MsgBox("不能运行AutoCAD，请检查是否安装了AutoCAD")
                Exit Sub
            End If
        End If
8 P' [; {1 L! [4 Y" A        AcadApp.Visible = True '界面可视
9 ~- c, x  b1 ~- K$ j" J        AcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
        AppActivate(AcadApp.Caption) '显示AutoCAD界面
& x, c7 Y% p9 `' e$ z1 U    End Sub
    Sub 齿轮刀具()
* W4 B2 ]4 _( T8 Q% J% A5 i        Dim R, Rf, Rb, Ra As Single
        R = m * Z / 2
2 |$ {1 u: F' H: N4 O        Rf = (R - 1.25 * m)
. Q2 L( {$ S3 H- n        Rb = R * Cos(Af)
        Ra = R + m
; z. F5 d2 q* r/ \0 c        Dim Sb, th(3)
( q7 r. C5 `; l+ k6 d        Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
        th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
% V7 O0 O9 o5 l6 [. F/ R4 @$ N! _        th(0) = th(1) / 3
& c8 t% X' b# @& y& \  I! Y        th(2) = th(1) + Tan(Af) - Af
7 z3 S$ K$ h9 H! T        th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
$ f* d+ v! K% Z7 t" W% e' x2 j        Dim curves(5) As AutoCAD.AcadEntity
        Dim points0(5) As Double
        Dim points1(8) As Double
! U$ ]$ d+ N' n/ A2 L        Dim points2(5) As Double
        points0(0) = 0 : points0(1) = Rf
, O0 F# }* ?3 X& B. l4 G        points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
# r2 V) }% o/ _- I3 m3 g        points0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
+ ^+ x! Z" }- t. U9 J        Dim startTan(2) As Double
        Dim endTan(2) As Double
8 l7 X5 M5 }% Q$ N/ P* R        startTan(0) = 0 : startTan(1) = 0 : startTan(2) = 0
        endTan(0) = 0.5 : endTan(1) = 0.5 : endTan(2) = 0
/ G% }" U! c3 K! }0 Y        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
4 p* f& {- `5 k; h        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
6 q- M4 d+ V" ?) ^        points2(4) = 0 : points2(5) = points2(3)
5 Y: _  H6 q8 ~2 l        If Rb < Rf Then
            points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03
3 S* S3 t) j' A, t% N            points0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
7 @+ n- i" U. j" B6 l            points1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
, ^  m0 A1 q$ E# B3 g6 B        End If
0 R. q& T5 u  l        curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
        curves(0).SetBulge(1, 0.2)
4 v! R7 J5 c0 h* l2 f) f1 u, ]& s        curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
        curves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
! q  R" [8 M" W1 D: O7 U        Dim point1(2) As Double
4 V9 w4 K3 t! i7 X$ L9 f        Dim point2(2) As Double
8 x3 p5 F  f' H" B        point1(0) = 0 : point1(1) = 0 : point1(2) = 0
        point2(0) = 0 : point2(1) = 1 : point2(2) = 0
/ h! ^  P: ?* ~        curves(3) = curves(2).Mirror(point1, point2)
1 k& J! g+ c/ Q# }8 A+ V        curves(4) = curves(1).Mirror(point1, point2)
        curves(5) = curves(0).Mirror(point1, point2)
        刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
        Dim taperAngle As Double
, |& }' z/ T9 g        taperAngle = 0
        Dim solidObj As AutoCAD.Acad3DSolid
        solidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
' F: z- D3 |) z7 V5 c9 e% Q7 g        Dim center(2) As Double
- N3 m2 T, y, f9 E" h3 ^  L        center(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
3 U5 B: ~' G2 S+ E6 Q- `1 j7 j        solidObj.Move(solidObj.Centroid, center)
* |; `# t/ o6 c        Dim basePnt(2) As Double
# b$ ]6 |9 M- C6 F, |        basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
/ p6 ]  i9 i+ U, o7 p2 t        刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
+ x4 w8 B4 q9 D    End Sub
    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged, TextBox2.TextChanged
3 k; n- @3 U' k- m, V7 M        Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
7 ~( \0 N# c# a: L" m        D4 = Val(Me.TextBox4.Text)
7 z% N$ _% c9 l" }/ V9 r, J        Me.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
) t3 Z$ g7 z# }. z& J& r0 i        Da = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
2 z% B/ \4 m+ a  {* \8 \6 R  u! 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
) X$ O  B8 b& z! l7 ]$ r, f' k! ]2 x        Call 连接AutoCAD()
        Dim entry As AutoCAD.AcadEntity
        For Each entry In AcadApp.ActiveDocument.ModelSpace
4 }' N" T. K8 c) a1 Q            entry.Delete()

- ?$ D$ r0 U5 f0 S' @