form13.frm

锥齿轮CAD设计

Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim acadapp As AcadApplication

Private Sub Command1_Click()                         '小齿轮制图

acadapp.Documents.Add


Dim cz As Double
Dim cm As Double
Dim ca As Double
Dim cr As Double
Dim crb As Double
Dim cra As Double
Dim crf As Double

cz = Text1.Text                   '齿数
cm = Text2.Text                   '模数
ca = Text3.Text * 3.1415926 / 180 '压力角
czd = Text10.Text                 '********什么意思？？？？

'设置画图比例。

Dim u As Double


If Option6.Value = True Then
u = 1
End If

If Option7.Value = True Then
u = 1 / 2
End If

If Option8.Value = True Then
u = 1 / 5
End If

If Option9.Value = True Then
u = 1 / 10
End If

If Option10.Value = True Then
u = 5
End If

If Option11.Value = True Then
u = 2
End If


'计算出最原始的数据。

cr = u * (cm * cz / 2)                '分度圆半径
crf = u * (cm * cz - 2.5 * cm) / 2    '齿根圆半径
'crb = u * cr * Cos(ca)               '基圆半径           ********为何式子也加分号-表示说明？
cra = u * (cm * cz + 2 * cm) / 2      '齿顶圆半径




'画图纸。
Dim tzc As Double          '图纸长
Dim tzk As Double          '图纸宽
Dim e As Double            '********表示什么？？？


'确定图纸的长与宽。

If Option1.Value = True Then
tzc = 1189
tzg = 841
e = 20                               '******** e表示什么意思？？？？离边框的距离？
End If

If Option2.Value = True Then
tzc = 841
tzg = 594
e = 20
End If

If Option3.Value = True Then
tzc = 594
tzg = 420
e = 10
End If

If Option4.Value = True Then
tzc = 420
tzg = 297
e = 10
End If

If Option5.Value = True Then
tzc = 297
tzg = 210
e = 10
End If


Dim zjl As Double   '定义不同图纸的不同左右上下距离。(左)       ******** 什么距离？
Dim yjl As Double  '(右距离)
Dim sjl As Double  '(上距离)
Dim xjl As Double  '(下距离)

If Option5.Value = True Then
zjl = 40
yjl = 40

End If

If Option4.Value = True Then
zjl = 50
yjl = 50

End If

If Option3.Value = True Then
zjl = 70
yjl = 70

End If

If Option2.Value = True Then
zjl = 80
yjl = 80

End If

If Option1.Value = True Then
zjl = 90
yjl = 90

End If




Dim tzdx1 As Double              '***********什么意思
Dim tzdx2 As Double
Dim tzdy1 As Double
Dim tzdy2 As Double

tzdx1 = -e
tzdx2 = tzc - e
tzdy1 = -e
tzdy2 = tzg - e




Dim tz As AcadLWPolyline                                           '************什么意思？
Dim points90(0 To 9) As Double '(-10,-10),(277,-10),(277,200),(-10,200),(-10,-10)
points90(0) = tzdx1: points90(1) = tzdy1
points90(2) = tzdx2: points90(3) = tzdy1
points90(4) = tzdx2: points90(5) = tzdy2
points90(6) = tzdx1: points90(7) = tzdy2
points90(8) = tzdx1: points90(9) = tzdy1

Set tz = acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points90)



'画图框（粗实线）。

Dim tkc As Double  '图框长
Dim tkg As Double  '图框高

tkc = tzc - 2 * e '选A4图纸
tkg = tzg - 2 * e




Dim tk As AcadLWPolyline                              '************什么意思？这些点是什么样的点？
Dim points0(0 To 9) As Double '(0,0),(287,0),(287,200),(0,200),(0,0)
points0(0) = 0: points0(1) = 0
points0(2) = tkc: points0(3) = 0
points0(4) = tkc: points0(5) = tkg
points0(6) = 0: points0(7) = tkg
points0(8) = 0: points0(9) = 0

Set tk = acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points0)          '????

tk.Lineweight = acLnWt030


'画标题栏(粗细实线）。

''粗实线部分。

Dim btkc As AcadLWPolyline
Dim points1(0 To 5) As Double                   '(157,0),(157,40),(287,40)
points1(0) = (tkc - 130): points1(1) = 0
points1(2) = (tkc - 130): points1(3) = 40
points1(4) = tkc: points1(5) = 40

Set btkc = acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points1)

btkc.Lineweight = acLnWt030

''细实线部分。（画线顺序为由下到上，由左到右）

Dim tkc0 As Double  '定义图框栏中X轴交点的坐标，从左到右。
Dim tkc1 As Double
Dim tkc2 As Double
Dim tkc3 As Double
Dim tkc4 As Double
Dim tkc5 As Double
Dim tkc6 As Double

tkc0 = tkc - 130                  '130是什么？？？
tkc1 = tkc - 130 + 12
tkc2 = tkc - 130 + 40
tkc3 = tkc - 130 + 65
tkc4 = tkc - 130 + 65 + 12
tkc5 = tkc - 130 + 65 + 30
tkc6 = tkc - 23


Dim btkx0 As AcadLine
Dim startpoint0(0 To 2) As Double '(157,8),(222,8)
Dim endpoint0(0 To 2) As Double
startpoint0(0) = tkc0#: startpoint0(1) = 8#: startpoint0(2) = 0#
endpoint0(0) = tkc3#: endpoint0(1) = 8#: endpoint0(2) = 0#
Set btkx0 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint0, endpoint0)

Dim btkx1 As AcadLine
Dim startpoint1(0 To 2) As Double '(157,16),(287,16)
Dim endpoint1(0 To 2) As Double
startpoint1(0) = tkc0#: startpoint1(1) = 16#: startpoint1(2) = 0#
endpoint1(0) = tkc#: endpoint1(1) = 16#: endpoint1(2) = 0#
Set btkx1 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint1, endpoint1)

Dim btkx2 As AcadLine
Dim startpoint2(0 To 2) As Double '(157,24),(287,24)
Dim endpoint2(0 To 2) As Double
startpoint2(0) = tkc0#: startpoint2(1) = 24#: startpoint2(2) = 0#
endpoint2(0) = tkc#: endpoint2(1) = 24#: endpoint2(2) = 0#
Set btkx2 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint2, endpoint2)

Dim btkx3 As AcadLine
Dim startpoint3(0 To 2) As Double '(222,32),(252,32)
Dim endpoint3(0 To 2) As Double
startpoint3(0) = tkc3#: startpoint3(1) = 32#: startpoint3(2) = 0#
endpoint3(0) = tkc5#: endpoint3(1) = 32#: endpoint3(2) = 0#
Set btkx3 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint3, endpoint3)

'''开始竖线。

Dim btkx4 As AcadLine
Dim startpoint4(0 To 2) As Double '(169,24),(169,0)
Dim endpoint4(0 To 2) As Double
startpoint4(0) = tkc1#: startpoint4(1) = 24#: startpoint4(2) = 0#
endpoint4(0) = tkc1#: endpoint4(1) = 0#: endpoint4(2) = 0#
Set btkx4 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint4, endpoint4)

Dim btkx5 As AcadLine
Dim startpoint5(0 To 2) As Double '(197,24),(197,0)
Dim endpoint5(0 To 2) As Double
startpoint5(0) = tkc2#: startpoint5(1) = 24#: startpoint5(2) = 0#
endpoint5(0) = tkc2#: endpoint5(1) = 0#: endpoint5(2) = 0#
Set btkx5 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint5, endpoint5)

Dim btkx6 As AcadLine
Dim startpoint6(0 To 2) As Double '(222,40),(222,0)
Dim endpoint6(0 To 2) As Double
startpoint6(0) = tkc3#: startpoint6(1) = 40#: startpoint6(2) = 0#
endpoint6(0) = tkc3#: endpoint6(1) = 0#: endpoint6(2) = 0#
Set btkx6 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint6, endpoint6)

Dim btkx7 As AcadLine
Dim startpoint7(0 To 2) As Double '(234,40),(234,16)
Dim endpoint7(0 To 2) As Double
startpoint7(0) = tkc4#: startpoint7(1) = 40#: startpoint7(2) = 0#
endpoint7(0) = tkc4#: endpoint7(1) = 16#: endpoint7(2) = 0#
Set btkx7 = acadapp.ActiveDocument.ModelSpace.AddLine(startpoint7, endpoint7)

Dim btkx8 As AcadLine
Dim startpoint8(0 To 2) As Double '(252,40),(252,16)
Dim endpoint8(0 To 2) As Double
startpoint8(0) = tkc5#: startpoint8(1) = 40#: startpoint8(2) = 0#
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)              ********怎么会是24，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)



'画总体中心线。中心线 zxx

Dim zxx00 As Double   '中心线在X轴起始与终止点。依次从左到右，从上到下。 ???怎么实现图纸选择的不同，它也不同？
Dim zxx01 As Double
Dim zxx02 As Double
Dim zxx03 As Double

Dim zxx04 As Double   '中心在Y轴的起点与终点坐标。
Dim zxx05 As Double

Dim zxx06 As Double   '定义中心线Y轴的坐标，与X轴的坐标。
Dim zxx07 As Double


Dim ch As Double
'ch = cra * 2 / 3

If Form9.Option15.Value = True Then
ch = 2 * cr * 1
ElseIf Form9.Option17.Value = True Then
ch = 2 * cr * 0.5
Else
ch = 2 * cr * 0.8
End If





          '中心线 zxx

zxx00 = zjl - 10
zxx01 = zjl + ch + 10  '“ch”为“齿轮厚度”，通常取为齿顶圆的1/3。????

zxx03 = tkc - yjl + 10
zxx02 = zxx03 - 2 * cra - 20

zxx06 = tkg / 2 + 20
zxx07 = tkc - yjl - cra '以上为定义画中心线时的点。

zxx04 = zxx06 + cra + 10
zxx05 = zxx06 - cra - 10

Dim vvv As Double
vvv = (cm * cz + 2 * cm) / 2

Dim vd0 As Double
Dim vd1 As Double
Dim vdd0 As Double
Dim vdd1 As Double