form014斜齿轮腹板式.frm

锥齿轮CAD设计

Dim btl19 As AcadText
Dim textstring19 As String
Dim height19 As Double
Dim insertionpoint19(0 To 2) As Double
'定义文字的高度和书写位置
textstring19 = Text9.Text
height19 = 3.5
insertionpoint19(0) = tkc - 90 + 1#: insertionpoint19(1) = 1.5: insertionpoint19(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl19 = acadapp.ActiveDocument.ModelSpace.AddText(textstring19, insertionpoint19, height19)


Dim btl20 As AcadText
Dim textstring20 As String
Dim height20 As Double
Dim insertionpoint20(0 To 2) As Double
'定义文字的高度和书写位置
textstring20 = "集大机制0113班"
height20 = 5.2
insertionpoint20(0) = tkc - 65 + 3#: insertionpoint20(1) = 3.2: insertionpoint20(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl20 = acadapp.ActiveDocument.ModelSpace.AddText(textstring20, insertionpoint20, height20)

                             ''''''''''技术条件jstj
Dim jstj0 As AcadText
Dim textstringjstj0 As String
Dim heightjstj0 As Double
Dim insertionpointjstj0(0 To 2) As Double
'定义文字的高度和书写位置
textstringjstj0 = "技术条件："
heightjstj0 = 5.2
insertionpointjstj0(0) = tkc - 130#: insertionpointjstj0(1) = 62: insertionpointjstj0(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set jstj0 = acadapp.ActiveDocument.ModelSpace.AddText(textstringjstj0, insertionpointjstj0, heightjstj0)

Dim jstj As AcadMText
Dim textstringjstj As String
Dim heightjstj As Double
Dim insertionpointjstj(0 To 2) As Double
'定义文字的高度和书写位置
textstringjstj = Text10.Text
heightjstj = 3.5
insertionpointjstj(0) = tkc - 130#: insertionpointjstj(1) = 56: insertionpointjstj(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set jstj = acadapp.ActiveDocument.ModelSpace.AddMText(insertionpointjstj, 80, textstringjstj) '(textstringjstj, insertionpointjstj, heightjstj)

                                  '''''''''齿轮说明框smk

Dim smk1 As AcadText
Dim textstringsmk1 As String
Dim heightsmk1 As Double
Dim insertionpointsmk1(0 To 2) As Double
'定义文字的高度和书写位置
textstringsmk1 = "模数(m)"
heightsmk1 = 3.5
insertionpointsmk1(0) = tkc - 65 + 2#: insertionpointsmk1(1) = tkg - 6: insertionpointsmk1(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set smk1 = acadapp.ActiveDocument.ModelSpace.AddText(textstringsmk1, insertionpointsmk1, heightsmk1)

Dim smk2 As AcadText
Dim textstringsmk2 As String
Dim heightsmk2 As Double
Dim insertionpointsmk2(0 To 2) As Double
'定义文字的高度和书写位置
textstringsmk2 = Text3.Text
heightsmk2 = 3.5
insertionpointsmk2(0) = tkc - 35 + 2#: insertionpointsmk2(1) = tkg - 6: insertionpointsmk2(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set smk2 = acadapp.ActiveDocument.ModelSpace.AddText(textstringsmk2, insertionpointsmk2, heightsmk2)

Dim smk3 As AcadText
Dim textstringsmk3 As String
Dim heightsmk3 As Double
Dim insertionpointsmk3(0 To 2) As Double
'定义文字的高度和书写位置
textstringsmk3 = "齿数(z)"
heightsmk3 = 3.5
insertionpointsmk3(0) = tkc - 65 + 2#: insertionpointsmk3(1) = tkg - 14: insertionpointsmk3(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set smk3 = acadapp.ActiveDocument.ModelSpace.AddText(textstringsmk3, insertionpointsmk3, heightsmk3)

Dim smk4 As AcadText
Dim textstringsmk4 As String
Dim heightsmk4 As Double
Dim insertionpointsmk4(0 To 2) As Double
'定义文字的高度和书写位置
textstringsmk4 = Text2.Text
heightsmk4 = 3.5
insertionpointsmk4(0) = tkc - 35 + 2#: insertionpointsmk4(1) = tkg - 14: insertionpointsmk4(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set smk4 = acadapp.ActiveDocument.ModelSpace.AddText(textstringsmk4, insertionpointsmk4, heightsmk4)

Dim smk5 As AcadText
Dim textstringsmk5 As String
Dim heightsmk5 As Double
Dim insertionpointsmk5(0 To 2) As Double
'定义文字的高度和书写位置
textstringsmk5 = "压力角(a)"
heightsmk5 = 3.5
insertionpointsmk5(0) = tkc - 65 + 2#: insertionpointsmk5(1) = tkg - 22: insertionpointsmk5(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set smk5 = acadapp.ActiveDocument.ModelSpace.AddText(textstringsmk5, insertionpointsmk5, heightsmk5)

Dim smk6 As AcadText
Dim textstringsmk6 As String
Dim heightsmk6 As Double
Dim insertionpointsmk6(0 To 2) As Double
'定义文字的高度和书写位置
textstringsmk6 = Text4.Text
heightsmk6 = 3.5
insertionpointsmk6(0) = tkc - 35 + 2#: insertionpointsmk6(1) = tkg - 22: insertionpointsmk6(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set smk6 = acadapp.ActiveDocument.ModelSpace.AddText(textstringsmk6, insertionpointsmk6, heightsmk6)



 '画齿轮剖视图。

Dim zbjl As Double         '左，右，上，下 边距离
Dim ybjl As Double
Dim sbjl As Double
Dim xbjl As Double

Dim dwxz As Double          '定位线左-左侧面线
Dim zxxsp As Double          '中心线左-水平线
Dim zxxy As Double          '中心线右-竖线
Dim wide As Double          '齿轮宽
Dim dj As Double            '倒角
Dim nj As Double            '内径-半径
Dim ndj As Double           '内倒角
Dim d As Double             '轴直径
Dim xdj As Double
''''''''腹板
Dim jl As Double            '腹板到轴中心的距离
Dim fbnj As Double          '腹板内径
Dim fbkd As Double          '腹板宽度
Dim fbsd As Double          '腹板深度
Dim dd1 As Double           '腹板外辕
Dim dx1 As Double           '腹板内辕
'Dim d0 As Double            '轴心
Dim c As Double



xdj = 1
d = Text1.Text
dwxz = zbjl
zxxsp = tzg / 2 + 20
zxxy = tzc - 2 * e - cra - 40            '3 * tkc / 8
wide = 1.2 * d
dj = 2
ndj = 2
nj = 10
ybjl = zxxy
'jl = 150
dd1 = 2 * (crf - 4 * cm)        'crf-q0     ,,,,''q0=2.5~4*m
fbnj = 0.25 * (dd1 - dx1)
dx1 = 1.6 * d
fbkd = 0.5 * (dd1 - dx1)
c = 0.3 * wide
fbsd = (wide - c) / 2

jl = 0.25 * (dd1 + dx1)

'd0 = 0.5 * (dd1 + dx1)

If Option5.Value Then
zbjl = 60
End If

If Option4.Value Then
zbjl = 100
End If

If Option3.Value Then
zbjl = 120
End If

If Option2.Value Then
zbjl = 150
End If

If Option1.Value Then
zbjl = 160
End If

'If cra < 150 Then
'Form0141.Show
'End If
'If cra > 500 Then
'Form0141.Show
'End If

                                              ''''''''''''''''''''''''左视图主轮廓
Dim ab As AcadLine
Dim startpointab(0 To 2) As Double
Dim endpointab(0 To 2) As Double
startpointab(0) = zbjl#: startpointab(1) = zxxsp#: startpointab(2) = 0#
endpointab(0) = zbjl#: endpointab(1) = zxxsp - cra + 2#: endpointab(2) = 0#
Set ab = acadapp.ActiveDocument.ModelSpace.AddLine(startpointab, endpointab)

Dim bc As AcadLine
Dim startpointbc(0 To 2) As Double
Dim endpointbc(0 To 2) As Double
startpointbc(0) = zbjl#: startpointbc(1) = zxxsp - cra + dj#: startpointbc(2) = 0#
endpointbc(0) = zbjl + dj#: endpointbc(1) = zxxsp - cra#: endpointbc(2) = 0#
Set bc = acadapp.ActiveDocument.ModelSpace.AddLine(startpointbc, endpointbc)

Dim cd As AcadLine
Dim startpointcd(0 To 2) As Double
Dim endpointcd(0 To 2) As Double
startpointcd(0) = zbjl + dj#: startpointcd(1) = zxxsp - cra#: startpointcd(2) = 0#
endpointcd(0) = zbjl + dj + wide - 2 * dj#: endpointcd(1) = zxxsp - cra#: endpointcd(2) = 0#
Set cd = acadapp.ActiveDocument.ModelSpace.AddLine(startpointcd, endpointcd)

Dim de As AcadLine
Dim startpointde(0 To 2) As Double
Dim endpointde(0 To 2) As Double
startpointde(0) = zbjl + wide - dj#: startpointde(1) = zxxsp - cra#: startpointde(2) = 0#
endpointde(0) = zbjl + wide#: endpointde(1) = zxxsp - cra + dj#: endpointde(2) = 0#
Set de = acadapp.ActiveDocument.ModelSpace.AddLine(startpointde, endpointde)

Dim ef As AcadLine
Dim startpointef(0 To 2) As Double
Dim endpointef(0 To 2) As Double
startpointef(0) = zbjl + wide#: startpointef(1) = zxxsp - cra + dj#: startpointef(2) = 0#
endpointef(0) = zbjl + wide#: endpointef(1) = zxxsp + cra - dj#: endpointef(2) = 0#
Set ef = acadapp.ActiveDocument.ModelSpace.AddLine(startpointef, endpointef)

Dim fg As AcadLine
Dim startpointfg(0 To 2) As Double
Dim endpointfg(0 To 2) As Double
startpointfg(0) = zbjl + wide#: startpointfg(1) = zxxsp + cra - dj#: startpointfg(2) = 0#
endpointfg(0) = zbjl + wide - dj#: endpointfg(1) = zxxsp + cra#: endpointfg(2) = 0#
Set fg = acadapp.ActiveDocument.ModelSpace.AddLine(startpointfg, endpointfg)

Dim gh As AcadLine
Dim startpointgh(0 To 2) As Double
Dim endpointgh(0 To 2) As Double
startpointgh(0) = zbjl + wide - dj#: startpointgh(1) = zxxsp + cra#: startpointgh(2) = 0#
endpointgh(0) = zbjl + dj#: endpointgh(1) = zxxsp + cra#: endpointgh(2) = 0#
Set gh = acadapp.ActiveDocument.ModelSpace.AddLine(startpointgh, endpointgh)

Dim hi As AcadLine
Dim startpointhi(0 To 2) As Double
Dim endpointhi(0 To 2) As Double
startpointhi(0) = zbjl + dj#: startpointhi(1) = zxxsp + cra#: startpointhi(2) = 0#
endpointhi(0) = zbjl#: endpointhi(1) = zxxsp + cra - dj#: endpointhi(2) = 0#
Set hi = acadapp.ActiveDocument.ModelSpace.AddLine(startpointhi, endpointhi)

Dim ia As AcadLine
Dim startpointia(0 To 2) As Double
Dim endpointia(0 To 2) As Double
startpointia(0) = zbjl#: startpointia(1) = zxxsp + cra - dj#: startpointia(2) = 0#
endpointia(0) = zbjl#: endpointia(1) = zxxsp#: endpointia(2) = 0#
Set ia = acadapp.ActiveDocument.ModelSpace.AddLine(startpointia, endpointia)

Dim jk As AcadLine
Dim startpointjk(0 To 2) As Double
Dim endpointjk(0 To 2) As Double
startpointjk(0) = zbjl#: startpointjk(1) = zxxsp + crf#: startpointjk(2) = 0#
endpointjk(0) = zbjl + wide#: endpointjk(1) = zxxsp + crf#: endpointjk(2) = 0#
Set jk = acadapp.ActiveDocument.ModelSpace.AddLine(startpointjk, endpointjk)

Dim lm As AcadLine
Dim startpointlm(0 To 2) As Double
Dim endpointlm(0 To 2) As Double
startpointlm(0) = zbjl#: startpointlm(1) = zxxsp - crf#: startpointlm(2) = 0#
endpointlm(0) = zbjl + wide#: endpointlm(1) = zxxsp - crf#: endpointlm(2) = 0#
Set lm = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlm, endpointlm)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''中间轴
Dim a11 As AcadLine
Dim startpointa11(0 To 2) As Double
Dim endpointa11(0 To 2) As Double
startpointa11(0) = zbjl#: startpointa11(1) = zxxsp + d / 2 + ndj#: startpointa11(2) = 0#
endpointa11(0) = zbjl + ndj#: endpointa11(1) = zxxsp + d / 2#: endpointa11(2) = 0#
Set a11 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa11, endpointa11)

Dim a12 As AcadLine
Dim startpointa12(0 To 2) As Double
Dim endpointa12(0 To 2) As Double
startpointa12(0) = zbjl + ndj#: startpointa12(1) = zxxsp + d / 2#: startpointa12(2) = 0#
endpointa12(0) = zbjl - ndj + wide#: endpointa12(1) = zxxsp + d / 2#: endpointa12(2) = 0#
Set a12 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa12, endpointa12)

Dim a13 As AcadLine
Dim startpointa13(0 To 2) As Double
Dim endpointa13(0 To 2) As Double
startpointa13(0) = zbjl - ndj + wide#: startpointa13(1) = zxxsp + d / 2#: startpointa13(2) = 0#
endpointa13(0) = zbjl + wide#: endpointa13(1) = zxxsp + d / 2 + ndj#: endpointa13(2) = 0#
Set a13 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa13, endpointa13)

Dim a14 As AcadLine
Dim startpointa14(0 To 2) As Double
Dim endpointa14(0 To 2) As Double
startpointa14(0) = zbjl + ndj#: startpointa14(1) = zxxsp + d / 2#: startpointa14(2) = 0#
endpointa14(0) = zbjl + ndj#: endpointa14(1) = zxxsp - d / 2#: endpointa14(2) = 0#
Set a14 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa14, endpointa14)

Dim a15 As AcadLine
Dim startpointa15(0 To 2) As Double
Dim endpointa15(0 To 2) As Double
startpointa15(0) = zbjl + ndj#: startpointa15(1) = zxxsp - d / 2#: startpointa15(2) = 0#
endpointa15(0) = zbjl#: endpointa15(1) = zxxsp - d / 2 - ndj#: endpointa15(2) = 0#
Set a15 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa15, endpointa15)

Dim a16 As AcadLine
Dim startpointa16(0 To 2) As Double
Dim endpointa16(0 To 2) As Double
startpointa16(0) = zbjl + ndj#: startpointa16(1) = zxxsp - d / 2#: startpointa16(2) = 0#
endpointa16(0) = zbjl + wide - ndj#: endpointa16(1) = zxxsp - d / 2#: endpointa16(2) = 0#
Set a16 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa16, endpointa16)

Dim a17 As AcadLine
Dim startpointa17(0 To 2) As Double
Dim endpointa17(0 To 2) As Double
startpointa17(0) = zbjl + wide - ndj#: startpointa17(1) = zxxsp - d / 2#: startpointa17(2) = 0#
endpointa17(0) = zbjl + wide#: endpointa17(1) = zxxsp - d / 2 - ndj#: endpointa17(2) = 0#
Set a17 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa17, endpointa17)

Dim a18 As AcadLine
Dim startpointa18(0 To 2) As Double
Dim endpointa18(0 To 2) As Double
startpointa18(0) = zbjl + wide - ndj#: startpointa18(1) = zxxsp - d / 2#: startpointa18(2) = 0#
endpointa18(0) = zbjl + wide - ndj#: endpointa18(1) = zxxsp + d / 2#: endpointa18(2) = 0#
Set a18 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointa18, endpointa18)


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''肋板上s
Dim lbs12 As AcadLine
Dim startpointlbs12(0 To 2) As Double
Dim endpointlbs12(0 To 2) As Double
startpointlbs12(0) = zbjl#: startpointlbs12(1) = zxxsp + jl + fbkd / 2 + ndj#: startpointlbs12(2) = 0#
endpointlbs12(0) = zbjl + ndj#: endpointlbs12(1) = zxxsp + jl + fbkd / 2#: endpointlbs12(2) = 0#
Set lbs12 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbs12, endpointlbs12)

Dim lbs23 As AcadLine
Dim startpointlbs23(0 To 2) As Double
Dim endpointlbs23(0 To 2) As Double
startpointlbs23(0) = zbjl + ndj#: startpointlbs23(1) = zxxsp + jl + fbkd / 2#: startpointlbs23(2) = 0#
endpointlbs23(0) = zbjl + ndj#: endpointlbs23(1) = zxxsp + jl - fbkd / 2#: endpointlbs23(2) = 0#
Set lbs23 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbs23, endpointlbs23)

Dim lbs34 As AcadLine
Dim startpointlbs34(0 To 2) As Double
Dim endpointlbs34(0 To 2) As Double
startpointlbs34(0) = zbjl + ndj#: startpointlbs34(1) = zxxsp + jl - fbkd / 2#: startpointlbs34(2) = 0#
endpointlbs34(0) = zbjl#: endpointlbs34(1) = zxxsp + jl - fbkd / 2 - ndj#: endpointlbs34(2) = 0#
Set lbs34 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbs34, endpointlbs34)

Dim lbs25 As AcadLine
Dim startpointlbs25(0 To 2) As Double
Dim endpointlbs25(0 To 2) As Double
startpointlbs25(0) = zbjl + ndj#: startpointlbs25(1) = zxxsp + jl + fbkd / 2#: startpointlbs25(2) = 0#
endpointlbs25(0) = zbjl + fbsd#: endpointlbs25(1) = zxxsp + jl + fbkd / 2#: endpointlbs25(2) = 0#