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

圣歌

Imports System.Math
Public Class Form1
6 \+ Q: e, r9 A) w" rDim AcadApp As AutoCAD.AcadApplication
, L3 Q" n( d8 D+ u( N, ~: @( KDim 刀具 As Object
, d+ ~, ], F' ^8 S5 w0 \ EDim Da, D0, D1, D2, D3, D4, n1, B, C As Double
0 _ Q% x' y( YDim Z, m, Af As Double
' m9 s; o8 U" m' p8 O4 e! KConst Pi = 3.141592
! V9 ]- z# p, U4 ?* WPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
& P* e' l+ D; E4 O( _Me.Text = "齿轮结构参数化三维造型"
Me.GroupBox1.Text = ""
4 M% y- P5 X" e& w5 F/ MMe.Label1.Text = "齿数Z"
Me.Label2.Text = "模数m"
Me.Label3.Text = "压力角Af"
' V0 T' j1 R: a* rMe.Label4.Text = "轴径D4"
Me.Label5.Text = "齿宽B"
4 U+ c5 k' ?& o F/ L5 sMe.Label6.Text = "D0"
Me.Label7.Text = "D3"
Me.TextBox1.Text = 40
- D! {3 N9 s& TMe.TextBox2.Text = 6
D1 r# G6 B+ ]( n8 R; vMe.TextBox3.Text = 20
Me.TextBox4.Text = CInt(Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) * 0.3)
D4 = Val(Me.TextBox4.Text)
5 ~5 u; `8 ?$ I- d# g" \2 X. NMe.TextBox5.Text = CInt(1.2 * Val(Me.TextBox4.Text))
! m+ [ C! }' {% X i6 E& E/ G, v+ RDa = Val(Me.TextBox1.Text) * Val(Me.TextBox2.Text) + 2 * Val(Me.TextBox2.Text)
Me.TextBox6.Text = Da - 12 * Val(Me.TextBox2.Text)
; a3 ^) w) X) n+ bMe.TextBox7.Text = 1.6 * D4
6 F8 o1 k* ^$ }* DMe.CheckBox1.Text = "画腹板孔"
Me.CheckBox1.Checked = True
Me.Button1.Text = "齿轮结构造型"
9 K' L# y" z) w$ R) Y3 N- kMe.Button2.Text = "结束"
End Sub
Sub 连接AutoCAD()
9 p# @% j( o$ i! Y; u9 Z/ k! IOn Error Resume Next
. B- a2 L! }. q" L" ?, oAcadApp = GetObject(, "AutoCAD.Application")
7 R9 v4 s9 v% q( M# AIf Err.Number Then
- R. {8 V. r* r0 G: w1 F( JErr.Clear()
AcadApp = CreateObject("AutoCAD.Application")
If Err.Number Then
MsgBox("不能运行AutoCAD，请检查是否安装了AutoCAD")
: {' O3 u( p4 _$ h8 z" f# GExit Sub
End If
7 l, R" w! _0 pEnd If
AcadApp.Visible = True '界面可视
* ^' y) M. i+ B4 E4 e0 n! \; U oAcadApp.WindowState = AutoCAD.AcWindowState.acMax '界面最大化
AppActivate(AcadApp.Caption) '显示AutoCAD界面
@( M6 {- K* f2 l$ P' xEnd Sub
Sub 齿轮刀具()
Dim R, Rf, Rb, Ra As Single
* n1 K$ L- s& v5 l: @/ sR = m * Z / 2
Rf = (R - 1.25 * m)
Rb = R * Cos(Af)
& l% t& @2 K9 J) hRa = R + m
+ t, t p1 o, oDim Sb, th(3)
( F6 |! n8 P9 {Sb = Cos(Af) * (3.14 * m / 2 + m * Z * (Tan(Af) - (Af)))
th(1) = (3.14 * m * Cos(Af) - Sb) / (2 * Rb)
: L! o5 Y" m( S3 {th(0) = th(1) / 3
th(2) = th(1) + Tan(Af) - Af
th(3) = th(1) + Tan(Acos(Rb / Ra)) - Acos(Rb / Ra)
: g2 K3 P* w; d6 e0 ~. y Z# ~Dim curves(5) As AutoCAD.AcadEntity
Dim points0(5) As Double
Dim points1(8) As Double
9 B+ O* m5 y* x7 IDim points2(5) As Double
1 i" x" _6 m B \points0(0) = 0 : points0(1) = Rf
points0(2) = Rf * Sin(th(0)) : points0(3) = Rf * Cos(th(0))
% {& q0 d0 B1 p! R! a/ Kpoints0(4) = Rb * Sin(th(1)) : points0(5) = Rb * Cos(th(1))
1 i7 m6 I- w! h) J( HDim startTan(2) As Double
Dim endTan(2) As Double
$ R$ H i! V( \# ^3 Z( N9 TstartTan(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
4 g0 z9 N e. mpoints1(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
L" d, s* N: X7 ^points2(0) = points1(6) : points2(1) = points1(7)
$ v+ \& g. s% G' w- ipoints2(2) = points1(6) : points2(3) = points1(7) + 2.25 * m
, r2 Z2 e4 Y( ]7 I& j: Xpoints2(4) = 0 : points2(5) = points2(3)
O: V! E; q0 Z" Z2 tIf Rb < Rf Then
points0(2) = points1(3) * 0.2 : points0(3) = points0(1) + 0.25 * m * 0.03
! S+ I# x L3 W5 E% a1 z$ Z% kpoints0(4) = points1(3) * 0.7 : points0(5) = points0(1) + 0.25 * m * 0.8
4 J+ u& u' K; ?0 f) Y- V! Gpoints1(0) = points0(4) : points1(1) = points0(5) : points1(2) = 0
( ^- L2 O* l! K! Y4 |1 m. W% pEnd If
curves(0) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)
# y G* ~7 Y$ t- S ?curves(0).SetBulge(1, 0.2)
curves(1) = AcadApp.ActiveDocument.ModelSpace.AddSpline(points1, startTan, endTan)
, l. ^2 j3 o8 R' ~; Mcurves(2) = AcadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)
" h1 i& u5 z1 h+ F9 `* b9 LDim point1(2) As Double
: v j! h/ J+ k: ^! @Dim point2(2) As Double
+ j! ?! P/ e% {% V1 w& epoint1(0) = 0 : point1(1) = 0 : point1(2) = 0
point2(0) = 0 : point2(1) = 1 : point2(2) = 0
' v( m6 u: k4 S9 u2 ~, |curves(3) = curves(2).Mirror(point1, point2)
* R& Q5 }: t8 p( u: i. Xcurves(4) = curves(1).Mirror(point1, point2)
curves(5) = curves(0).Mirror(point1, point2)
" `' ^" {( G3 k刀具 = AcadApp.ActiveDocument.ModelSpace.AddRegion(curves)
Dim taperAngle As Double
' E$ a! {0 Q+ [0 l5 x4 OtaperAngle = 0
Dim solidObj As AutoCAD.Acad3DSolid
1 d" R. A) p/ osolidObj = AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolid(刀具(0), B * 1.1, taperAngle)
) j( b% j7 V! ~9 ]1 T4 EDim center(2) As Double
: `( k# { M* A5 h$ Q* l" ecenter(0) = 0 : center(1) = solidObj.Centroid(1) : center(2) = 0
solidObj.Move(solidObj.Centroid, center)
Dim basePnt(2) As Double
2 I- V1 r. t$ o5 o3 `basePnt(0) = 0 : basePnt(1) = 0 : basePnt(2) = 0.0#
刀具 = solidObj.ArrayPolar(Z + 1, 2 * Pi, basePnt)
End Sub
9 N1 C$ @% E9 n. I3 e2 dPrivate 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)
* } B0 ]9 S( y+ {: G) ]- lD4 = 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
4 J9 y- ^% L) X6 U4 wEnd Sub
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()
2 o) R8 Q1 ^' `$ g. s2 k) m: H
) J7 I" p: B' l9 F. p C& A