form012斜齿轮齿轮轴.frm

锥齿轮CAD设计

Dim btl4 As AcadText
Dim textstring4 As String
Dim height4 As Double
Dim insertionpoint4(0 To 2) As Double
'定义文字的高度和书写位置
textstring4 = "数量"
height4 = 3.5
insertionpoint4(0) = tkc - 65 + 1#: insertionpoint4(1) = 25.5: insertionpoint4(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl4 = acadapp.ActiveDocument.ModelSpace.AddText(textstring4, insertionpoint4, height4)



Dim btl5 As AcadText
Dim textstring5 As String
Dim height5 As Double
Dim insertionpoint5(0 To 2) As Double
'定义文字的高度和书写位置
textstring5 = "1"
height5 = 3.5
insertionpoint5(0) = tkc - 53 + 1#: insertionpoint5(1) = 25.5: insertionpoint5(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl5 = acadapp.ActiveDocument.ModelSpace.AddText(textstring5, insertionpoint5, height5)


Dim btl6 As AcadText
Dim textstring6 As String
Dim height6 As Double
Dim insertionpoint6(0 To 2) As Double
'定义文字的高度和书写位置

If Option5.Value Then
textstring6 = "A4"
End If

If Option4.Value Then
textstring6 = "A3"
End If

If Option3.Value Then
textstring6 = "A2"
End If

If Option2.Value Then
textstring6 = "A1"
End If

If Option1.Value Then
textstring6 = "A0"
End If

height6 = 8
insertionpoint6(0) = tkc - 35 + 3#: insertionpoint6(1) = 25.5: insertionpoint6(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl6 = acadapp.ActiveDocument.ModelSpace.AddText(textstring6, insertionpoint6, height6)


'''制图
Dim btl7 As AcadText
Dim textstring7 As String
Dim height7 As Double
Dim insertionpoint7(0 To 2) As Double
'定义文字的高度和书写位置
textstring7 = "制图"
height7 = 3.5
insertionpoint7(0) = tkc - 130 + 1#: insertionpoint7(1) = 17.5: insertionpoint7(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl7 = acadapp.ActiveDocument.ModelSpace.AddText(textstring7, insertionpoint7, height7)

Dim btl8 As AcadText
Dim textstring8 As String
Dim height8 As Double
Dim insertionpoint8(0 To 2) As Double
'定义文字的高度和书写位置
textstring8 = Text5.Text
height8 = 3.5
insertionpoint8(0) = tkc - 118 + 1#: insertionpoint8(1) = 17.5: insertionpoint8(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl8 = acadapp.ActiveDocument.ModelSpace.AddText(textstring8, insertionpoint8, height8)

Dim btl9 As AcadText
Dim textstring9 As String
Dim height9 As Double
Dim insertionpoint9(0 To 2) As Double
'定义文字的高度和书写位置
textstring9 = Text9.Text
height9 = 3.5
insertionpoint9(0) = tkc - 90 + 1#: insertionpoint9(1) = 17.5: insertionpoint9(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl9 = acadapp.ActiveDocument.ModelSpace.AddText(textstring9, insertionpoint9, height9)


Dim btl10 As AcadText
Dim textstring10 As String
Dim height10 As Double
Dim insertionpoint10(0 To 2) As Double
'定义文字的高度和书写位置
textstring10 = "材料"
height10 = 3.5
insertionpoint10(0) = tkc - 65 + 1#: insertionpoint10(1) = 17.5: insertionpoint10(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl10 = acadapp.ActiveDocument.ModelSpace.AddText(textstring10, insertionpoint10, height10)

Dim btl11 As AcadText
Dim textstring11 As String
Dim height11 As Double
Dim insertionpoint11(0 To 2) As Double
'定义文字的高度和书写位置
textstring11 = Text8.Text
height11 = 3.5
insertionpoint11(0) = tkc - 53 + 1#: insertionpoint11(1) = 17.5: insertionpoint11(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl11 = acadapp.ActiveDocument.ModelSpace.AddText(textstring11, insertionpoint11, height11)

Dim btl12 As AcadText
Dim textstring12 As String
Dim height12 As Double
Dim insertionpoint12(0 To 2) As Double
'定义文字的高度和书写位置
textstring12 = "重量"
height12 = 3.5
insertionpoint12(0) = tkc - 35 + 1#: insertionpoint12(1) = 17.5: insertionpoint12(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl12 = acadapp.ActiveDocument.ModelSpace.AddText(textstring12, insertionpoint12, height12)

Dim btl13 As AcadText
Dim textstring13 As String
Dim height13 As Double
Dim insertionpoint13(0 To 2) As Double
'定义文字的高度和书写位置
textstring13 = "重量"
height13 = 3.5
insertionpoint13(0) = tkc - 23 + 1#: insertionpoint13(1) = 17.5: insertionpoint13(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl13 = acadapp.ActiveDocument.ModelSpace.AddText(textstring13, insertionpoint13, height13)
                                                              
                                                              '''绘图
Dim btl14 As AcadText
Dim textstring14 As String
Dim height14 As Double
Dim insertionpoint14(0 To 2) As Double
'定义文字的高度和书写位置
textstring14 = "绘图"
height14 = 3.5
insertionpoint14(0) = tkc - 130 + 1#: insertionpoint14(1) = 9.5: insertionpoint14(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl14 = acadapp.ActiveDocument.ModelSpace.AddText(textstring14, insertionpoint14, height14)

Dim btl15 As AcadText
Dim textstring15 As String
Dim height15 As Double
Dim insertionpoint15(0 To 2) As Double
'定义文字的高度和书写位置
textstring15 = Text6.Text
height15 = 3.5
insertionpoint15(0) = tkc - 118 + 1#: insertionpoint15(1) = 9.5: insertionpoint15(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl15 = acadapp.ActiveDocument.ModelSpace.AddText(textstring15, insertionpoint15, height15)

Dim btl16 As AcadText
Dim textstring16 As String
Dim height16 As Double
Dim insertionpoint16(0 To 2) As Double
'定义文字的高度和书写位置
textstring16 = Text9.Text
height16 = 3.5
insertionpoint16(0) = tkc - 90 + 1#: insertionpoint16(1) = 9.5: insertionpoint16(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl16 = acadapp.ActiveDocument.ModelSpace.AddText(textstring16, insertionpoint16, height16)

                                                              '''审核
Dim btl17 As AcadText
Dim textstring17 As String
Dim height17 As Double
Dim insertionpoint17(0 To 2) As Double
'定义文字的高度和书写位置
textstring17 = "审核"
height17 = 3.5
insertionpoint17(0) = tkc - 130 + 1#: insertionpoint17(1) = 1.5: insertionpoint17(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl17 = acadapp.ActiveDocument.ModelSpace.AddText(textstring17, insertionpoint17, height17)

Dim btl18 As AcadText
Dim textstring18 As String
Dim height18 As Double
Dim insertionpoint18(0 To 2) As Double
'定义文字的高度和书写位置
textstring18 = Text7.Text
height18 = 3.5
insertionpoint18(0) = tkc - 118 + 1#: insertionpoint18(1) = 1.5: insertionpoint18(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl18 = acadapp.ActiveDocument.ModelSpace.AddText(textstring18, insertionpoint18, height18)

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 AcadText
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.AddText(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 clzbj As Double         '齿轮轴半径


dwxz = zbjl
zxxsp = tzg / 2 + 20
zxxy = tzc - 2 * e - tkc / 4
wide = 40
dj = 2
ndj = 2
nj = 10
ybjl = zxxy
clzbj = Text1.Text

If Option5.Value Then
zbjl = 40 + 10
End If

If Option4.Value Then
zbjl = 50 + 10
End If

If Option3.Value Then
zbjl = 60 + 10
End If

If Option2.Value Then
zbjl = 70 + 10
End If

If Option1.Value Then
zbjl = 80 + 10
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)