📄 form014斜齿轮腹板式.frm
字号:
EndProperty
Height = 210
Left = 720
TabIndex = 35
Top = 3480
Width = 1815
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "3.标题栏"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 720
TabIndex = 34
Top = 6000
Width = 915
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "制 图："
Height = 180
Left = 720
TabIndex = 33
Top = 6480
Width = 900
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "绘 图："
Height = 180
Index = 0
Left = 720
TabIndex = 32
Top = 6900
Width = 900
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "审 核："
Height = 180
Left = 720
TabIndex = 31
Top = 7320
Width = 900
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "材 料："
Height = 180
Left = 720
TabIndex = 30
Top = 7740
Width = 900
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "日 期："
Height = 180
Left = 720
TabIndex = 29
Top = 8160
Width = 900
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "4.确定零件图比例："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3720
TabIndex = 28
Top = 360
Width = 2040
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "5.填写技术条件："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3720
TabIndex = 27
Top = 3480
Width = 1815
End
End
Attribute VB_Name = "Form014"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
End Sub
Private Sub Command2_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 '齿数，模数，压力角，分度圆r，基圆r，齿顶圆r，齿底圆r
cz = Text2.Text '小齿轮齿数
cm = Text3.Text '模数
ca = Text4.Text * 3.1415926 / 180 '压力角
czd = Text1.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 'A0
tzc = 1189
tzg = 841
e = 20
End If
If Option2.Value = True Then 'A1
tzc = 841
tzg = 594
e = 20
End If
If Option3.Value = True Then 'A2
tzc = 594
tzg = 420
e = 10
End If
If Option4.Value = True Then 'A3
tzc = 420
tzg = 297
e = 10
End If
If Option5.Value = True Then 'A4
tzc = 297
tzg = 210
e = 10
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 '图框长tkc
Dim tkc2 As Double
Dim tkc3 As Double
Dim tkc4 As Double
Dim tkc5 As Double
Dim tkc6 As Double
tkc0 = tkc - 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#
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -