form014斜齿轮腹板式.frm

锥齿轮CAD设计

endpoint8(0) = tkc5#: endpoint8(1) = 16#: endpoint8(2) = 0#
Set btkx8 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint8, endpoint8)

Dim btkx9 As AcadLine
Dim startpoint9(0 To 2) As Double '(264,24),(264,16)
Dim endpoint9(0 To 2) As Double
startpoint9(0) = tkc6#: startpoint9(1) = 24#: startpoint9(2) = 0#
endpoint9(0) = tkc6#: endpoint9(1) = 16#: endpoint9(2) = 0#
Set btkx9 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint9, endpoint9)




                         '画右上角齿轮说明框。(从下到上，从左到右，细实线。）

Dim smkx As AcadLine
Dim startpoint(0 To 2) As Double '(264,24),(264,16)
Dim endpoint(0 To 2) As Double
startpoint(0) = smkc#: startpoint(1) = smkg#: startpoint(2) = 0#
endpoint(0) = smkc#: endpoint(1) = smkg#: endpoint(2) = 0#
Set smkx = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint, endpoint)


Dim smkc0 As Double  '定义说明图框栏中X轴交点的坐标，从左到右。
Dim smkc1 As Double

smkc0 = tkc - 65
smkc1 = tkc - 35

Dim smkg0 As Double  '定义说明图框栏中y轴交点的坐标，从下到上。
Dim smkg1 As Double
Dim smkg2 As Double

smkg0 = tkg - 24
smkg1 = tkg - 16
smkg2 = tkg - 8

Dim smkx0 As AcadLine
Dim startpoint00(0 To 2) As Double '(222,186),(287,186)
Dim endpoint00(0 To 2) As Double
startpoint00(0) = smkc0#: startpoint00(1) = smkg0#: startpoint00(2) = 0#
endpoint00(0) = tkc#: endpoint00(1) = smkg0#: endpoint00(2) = 0#
Set smkx0 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint00, endpoint00)

Dim smkx1 As AcadLine
Dim startpoint01(0 To 2) As Double '(222,194),(287,194)
Dim endpoint01(0 To 2) As Double
startpoint01(0) = smkc0#: startpoint01(1) = smkg1#: startpoint01(2) = 0#
endpoint01(0) = tkc#: endpoint01(1) = smkg1#: endpoint01(2) = 0#
Set smkx1 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint01, endpoint01)

Dim smkx2 As AcadLine
Dim startpoint02(0 To 2) As Double '(222,202),(287,202)
Dim endpoint02(0 To 2) As Double
startpoint02(0) = smkc0#: startpoint02(1) = smkg2#: startpoint02(2) = 0#
endpoint02(0) = tkc#: endpoint02(1) = smkg2#: endpoint02(2) = 0#
Set smkx2 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint02, endpoint02)


                                  '''画竖线.

Dim smkx3 As AcadLine
Dim startpoint03(0 To 2) As Double '(222,200),(222,186)
Dim endpoint03(0 To 2) As Double
startpoint03(0) = smkc0#: startpoint03(1) = tkg#: startpoint03(2) = 0#
endpoint03(0) = smkc0#: endpoint03(1) = smkg0#: endpoint03(2) = 0#
Set smkx3 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint03, endpoint03)

Dim smkx4 As AcadLine
Dim startpoint04(0 To 2) As Double '(252,200),(252,186)
Dim endpoint04(0 To 2) As Double
startpoint04(0) = smkc1#: startpoint04(1) = tkg#: startpoint04(2) = 0#
endpoint04(0) = smkc1#: endpoint04(1) = smkg0#: endpoint04(2) = 0#
Set smkx4 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint04, endpoint04)



                                                 '''''''''''标题栏（btl）书写

Dim styobj1 As AcadTextStyle  '定义格式一。
Dim typeface As String
Dim bold As Boolean
Dim italic As Boolean
Dim charset As Long
Dim pitchandfamily As Long
Set styobj1 = acadapp.ActiveDocument.TextStyles.Add("样式一")
typeface = "宋体"
italic = False
bold = False
charset = 1
pitchandfamily = 1  '？
styobj1.SetFont typeface, bold, italic, charest, pitchandfimily

Dim styobj2 As AcadTextStyle  '定义样式二。
Set styobj2 = acadapp.ActiveDocument.TextStyles.Add("样式二")
styobj2.fontFile = "c:\windows\fonts\simhei.ttf"            '仿宋体'



Dim btl1 As AcadText
Dim textstring1 As String
Dim height1 As Double
Dim insertionpoint1(0 To 2) As Double
'定义文字的高度和书写位置
textstring1 = "斜齿轮腹板式"
height1 = 7
insertionpoint1(0) = tkc - 130 + 3#: insertionpoint1(1) = 29: insertionpoint1(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl1 = acadapp.ActiveDocument.ModelSpace.AddText(textstring1, insertionpoint1, height1)

Dim btl2 As AcadText
Dim textstring2 As String
Dim height2 As Double
Dim insertionpoint2(0 To 2) As Double
'定义文字的高度和书写位置
textstring2 = "比例"
height2 = 3.5
insertionpoint2(0) = tkc - 65 + 1#: insertionpoint2(1) = 33.5: insertionpoint2(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl2 = acadapp.ActiveDocument.ModelSpace.AddText(textstring2, insertionpoint2, height2)

Dim btl3 As AcadText           '''比例
Dim textstring3 As String
Dim height3 As Double
Dim insertionpoint3(0 To 2) As Double
'定义文字的高度和书写位置

If Option6.Value = True Then
textstring3 = "1:1"
End If

If Option7.Value = True Then
textstring3 = "1:2"
End If

If Option8.Value = True Then
textstring3 = "1:5"
End If

If Option9.Value = True Then
textstring3 = "1:10"
End If

If Option10.Value = True Then
textstring3 = "5:1"
End If

If Option11.Value = True Then
textstring3 = "2:1"
End If

height3 = 3.5
insertionpoint3(0) = tkc - 53 + 1#: insertionpoint3(1) = 33.5: insertionpoint3(2) = 0#

acadapp.ActiveDocument.ActiveTextStyle = styobj2
Set btl3 = acadapp.ActiveDocument.ModelSpace.AddText(textstring3, insertionpoint3, height3)


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)