form014斜齿轮腹板式.frm

锥齿轮CAD设计

Set lbs25 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbs25, endpointlbs25)

Dim lbs56 As AcadLine
Dim startpointlbs56(0 To 2) As Double
Dim endpointlbs56(0 To 2) As Double
startpointlbs56(0) = zbjl + fbsd#: startpointlbs56(1) = zxxsp + jl + fbkd / 2#: startpointlbs56(2) = 0#
endpointlbs56(0) = zbjl + fbsd#: endpointlbs56(1) = zxxsp + jl - fbkd / 2#: endpointlbs56(2) = 0#
Set lbs56 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbs56, endpointlbs56)

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

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

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

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

Dim lbst7 As AcadLine
Dim startpointlbst7(0 To 2) As Double
Dim endpointlbst7(0 To 2) As Double
startpointlbst7(0) = zbjl + wide - ndj#: startpointlbst7(1) = zxxsp + jl + fbkd / 2#: startpointlbst7(2) = 0#
endpointlbst7(0) = zbjl + wide - fbsd#: endpointlbst7(1) = zxxsp + jl + fbkd / 2#: endpointlbst7(2) = 0#
Set lbst7 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbst7, endpointlbst7)

Dim lbs78 As AcadLine
Dim startpointlbs78(0 To 2) As Double
Dim endpointlbs78(0 To 2) As Double
startpointlbs78(0) = zbjl + wide - fbsd#: startpointlbs78(1) = zxxsp + jl + fbkd / 2#: startpointlbs78(2) = 0#
endpointlbs78(0) = zbjl + wide - fbsd#: endpointlbs78(1) = zxxsp + jl - fbkd / 2#: endpointlbs78(2) = 0#
Set lbs78 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbs78, endpointlbs78)

Dim lbs89 As AcadLine
Dim startpointlbs89(0 To 2) As Double
Dim endpointlbs89(0 To 2) As Double
startpointlbs89(0) = zbjl + wide - fbsd#: startpointlbs89(1) = zxxsp + jl - fbkd / 2#: startpointlbs89(2) = 0#
endpointlbs89(0) = zbjl + wide - ndj#: endpointlbs89(1) = zxxsp + jl - fbkd / 2#: endpointlbs89(2) = 0#
Set lbs89 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbs89, endpointlbs89)

Dim lbspq As AcadLine
Dim startpointlbspq(0 To 2) As Double
Dim endpointlbspq(0 To 2) As Double
startpointlbspq(0) = zbjl + fbsd#: startpointlbspq(1) = zxxsp + jl + fbnj / 2#: startpointlbspq(2) = 0#
endpointlbspq(0) = zbjl + wide - fbsd#: endpointlbspq(1) = zxxsp + jl + fbnj / 2#: endpointlbspq(2) = 0#
Set lbspq = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbspq, endpointlbspq)

Dim lbsrs As AcadLine
Dim startpointlbsrs(0 To 2) As Double
Dim endpointlbsrs(0 To 2) As Double
startpointlbsrs(0) = zbjl + fbsd#: startpointlbsrs(1) = zxxsp + jl - fbnj / 2#: startpointlbsrs(2) = 0#
endpointlbsrs(0) = zbjl + wide - fbsd#: endpointlbsrs(1) = zxxsp + jl - fbnj / 2#: endpointlbsrs(2) = 0#
Set lbsrs = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbsrs, endpointlbsrs)


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''肋板下x
Dim lbx12 As AcadLine
Dim startpointlbx12(0 To 2) As Double
Dim endpointlbx12(0 To 2) As Double
startpointlbx12(0) = zbjl#: startpointlbx12(1) = zxxsp - jl + fbkd / 2 + ndj#: startpointlbx12(2) = 0#
endpointlbx12(0) = zbjl + ndj#: endpointlbx12(1) = zxxsp - jl + fbkd / 2#: endpointlbx12(2) = 0#
Set lbx12 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbx12, endpointlbx12)

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

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

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

Dim lbx56 As AcadLine
Dim startpointlbx56(0 To 2) As Double
Dim endpointlbx56(0 To 2) As Double
startpointlbx56(0) = zbjl + fbsd#: startpointlbx56(1) = zxxsp - jl + fbkd / 2#: startpointlbx56(2) = 0#
endpointlbx56(0) = zbjl + fbsd#: endpointlbx56(1) = zxxsp - jl - fbkd / 2#: endpointlbx56(2) = 0#
Set lbx56 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbx56, endpointlbx56)

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

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

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

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

Dim lbxt7 As AcadLine
Dim startpointlbxt7(0 To 2) As Double
Dim endpointlbxt7(0 To 2) As Double
startpointlbxt7(0) = zbjl + wide - ndj#: startpointlbxt7(1) = zxxsp - jl + fbkd / 2#: startpointlbxt7(2) = 0#
endpointlbxt7(0) = zbjl + wide - fbsd#: endpointlbxt7(1) = zxxsp - jl + fbkd / 2#: endpointlbxt7(2) = 0#
Set lbxt7 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbxt7, endpointlbxt7)

Dim lbx78 As AcadLine
Dim startpointlbx78(0 To 2) As Double
Dim endpointlbx78(0 To 2) As Double
startpointlbx78(0) = zbjl + wide - fbsd#: startpointlbx78(1) = zxxsp - jl + fbkd / 2#: startpointlbx78(2) = 0#
endpointlbx78(0) = zbjl + wide - fbsd#: endpointlbx78(1) = zxxsp - jl - fbkd / 2#: endpointlbx78(2) = 0#
Set lbx78 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbx78, endpointlbx78)

Dim lbx89 As AcadLine
Dim startpointlbx89(0 To 2) As Double
Dim endpointlbx89(0 To 2) As Double
startpointlbx89(0) = zbjl + wide - fbsd#: startpointlbx89(1) = zxxsp - jl - fbkd / 2#: startpointlbx89(2) = 0#
endpointlbx89(0) = zbjl + wide - ndj#: endpointlbx89(1) = zxxsp - jl - fbkd / 2#: endpointlbx89(2) = 0#
Set lbx89 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbx89, endpointlbx89)

Dim lbxpq As AcadLine
Dim startpointlbxpq(0 To 2) As Double
Dim endpointlbxpq(0 To 2) As Double
startpointlbxpq(0) = zbjl + fbsd#: startpointlbxpq(1) = zxxsp - jl + fbnj / 2#: startpointlbxpq(2) = 0#
endpointlbxpq(0) = zbjl + wide - fbsd#: endpointlbxpq(1) = zxxsp - jl + fbnj / 2#: endpointlbxpq(2) = 0#
Set lbxpq = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbxpq, endpointlbxpq)

Dim lbxrs As AcadLine
Dim startpointlbxrs(0 To 2) As Double
Dim endpointlbxrs(0 To 2) As Double
startpointlbxrs(0) = zbjl + fbsd#: startpointlbxrs(1) = zxxsp - jl - fbnj / 2#: startpointlbxrs(2) = 0#
endpointlbxrs(0) = zbjl + wide - fbsd#: endpointlbxrs(1) = zxxsp - jl - fbnj / 2#: endpointlbxrs(2) = 0#
Set lbxrs = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlbxrs, endpointlbxrs)

'''''''''''''''''''''''''''''''''''''''''''''右视图




Dim cdy As AcadCircle         '齿顶圆
Dim centerpointcdy(0 To 2) As Double
centerpointcdy(0) = ybjl#: centerpointcdy(1) = zxxsp#: centerpointcdy(2) = 0#:
Set cdy = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointcdy, cra)

cdy.Lineweight = acLnWt30

Dim cgy As AcadCircle         '齿根圆
Dim centerpointcgy(0 To 2) As Double
centerpointcgy(0) = ybjl#: centerpointcgy(1) = zxxsp#: centerpointcgy(2) = 0#:
Set cgy = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointcgy, crf)

cgy.Lineweight = acLnWt30

Dim nk As AcadCircle         '内孔
Dim centerpointnk(0 To 2) As Double
centerpointnk(0) = ybjl#: centerpointnk(1) = zxxsp#: centerpointnk(2) = 0#:
Set nk = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointnk, d / 2)

nk.Lineweight = acLnWt30

Dim nkdj As AcadCircle         '内孔
Dim centerpointnkdj(0 To 2) As Double
centerpointnkdj(0) = ybjl#: centerpointnkdj(1) = zxxsp#: centerpointnkdj(2) = 0#:
Set nkdj = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointnkdj, (d + ndj) / 2)

nkdj.Lineweight = acLnWt030


Dim fbk1 As AcadCircle                                      '腹板孔
Dim centerpointfbk1(0 To 2) As Double
centerpointfbk1(0) = ybjl#: centerpointfbk1(1) = zxxsp + jl#: centerpointfbk1(2) = 0#:
Set fbk1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbk1, fbnj / 2)

fbk1.Lineweight = acLnWt030

Dim fbk2 As AcadCircle                                      '腹板孔
Dim centerpointfbk2(0 To 2) As Double
centerpointfbk2(0) = ybjl - jl#: centerpointfbk2(1) = zxxsp#: centerpointfbk2(2) = 0#:
Set fbk2 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbk2, fbnj / 2)

fbk2.Lineweight = acLnWt030

Dim fbk3 As AcadCircle                                      '腹板孔
Dim centerpointfbk3(0 To 2) As Double
centerpointfbk3(0) = ybjl#: centerpointfbk3(1) = zxxsp - jl#: centerpointfbk3(2) = 0#:
Set fbk3 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbk3, fbnj / 2)

fbk3.Lineweight = acLnWt030

Dim fbk4 As AcadCircle                                      '腹板孔
Dim centerpointfbk4(0 To 2) As Double
centerpointfbk4(0) = ybjl + jl#: centerpointfbk4(1) = zxxsp#: centerpointfbk4(2) = 0#:
Set fbk4 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbk4, fbnj / 2)

fbk4.Lineweight = acLnWt030


Dim fbby1 As AcadCircle                                      '腹板外圆
Dim centerpointfbby1(0 To 2) As Double
centerpointfbby1(0) = ybjl#: centerpointfbby1(1) = zxxsp#: centerpointfbby1(2) = 0#:
Set fbby1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbby1, jl + fbkd / 2 + ndj)

fbby1.Lineweight = acLnWt030

Dim fbby2 As AcadCircle                                      '腹板外圆
Dim centerpointfbby2(0 To 2) As Double
centerpointfbby2(0) = ybjl#: centerpointfbby2(1) = zxxsp#: centerpointfbby2(2) = 0#:
Set fbby2 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbby2, jl + fbkd / 2)

fbby2.Lineweight = acLnWt030

Dim fbby3 As AcadCircle                                      '腹板内圆
Dim centerpointfbby3(0 To 2) As Double
centerpointfbby3(0) = ybjl#: centerpointfbby3(1) = zxxsp#: centerpointfbby3(2) = 0#:
Set fbby3 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbby3, jl - fbkd / 2 - ndj)

fbby3.Lineweight = acLnWt030

Dim fbby4 As AcadCircle                                      '腹板内圆
Dim centerpointfbby4(0 To 2) As Double
centerpointfbby4(0) = ybjl#: centerpointfbby4(1) = zxxsp#: centerpointfbby4(2) = 0#:
Set fbby4 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointfbby4, jl - fbkd / 2)

fbby4.Lineweight = acLnWt030





                               '''''''''''''''''''''''''''''''''''''''''''''标注bz

Dim bz1 As AcadDimAligned             ''''''''''齿顶圆
Dim point11(0 To 2) As Double
Dim point12(0 To 2) As Double
Dim location1(0 To 2) As Double


'定义尺寸标注。
point11(0) = zbjl + wide - dj#: point11(1) = zxxsp + cra#: point11(2) = 0#
point12(0) = zbjl + wide - dj#: point12(1) = zxxsp - cra#: point12(2) = 0#

location1(0) = zbjl + wide - dj + 50#: location1(1) = 0#: location1(2) = 0#

'创建平行尺寸标注对象。
If Option6.Value = True Then
Set bz1 = acadapp.ActiveDocument.ModelSpace.AddDimAligned(point11, point12, location1)
bz1.TextPrefix = "%%c"
Else
''''''''''''''''''''''''''''''''''自己写尺寸@@@@@@@@@@@@@@@
Set bz1 = acadapp.ActiveDocument.ModelSpace.AddDimAligned(point11, point12, location1)
Dim zbz1 As Integer
zbz1 = cm * (cz + 2) / 3
bz1.TextOverride = "%%c" & zbz1

End If
                                      '标注公差。  "%%c" & Str(zbz5 )
                                        
bz1.DecimalSeparator = "."   '小数点符号。
'公差显示特性。
bz1.ToleranceDisplay = acTolSymmetrical  '对称显示公差。
bz1.TolerancePrecision = acDimPrecisionFour   '4位小数
bz1.ToleranceHeightScale = 0.5  '偏差文本高度为尺寸高度的一半。
'设置公差。
bz1.ToleranceLowerLimit = 0.3
bz1.ToleranceUpperLimit = 0.021

bz1.Update


Dim bz2 As AcadDimAligned                ''''''齿根圆
Dim point21(0 To 2) As Double
Dim point22(0 To 2) As Double
Dim location2(0 To 2) As Double


'定义尺寸标注。
point21(0) = zbjl + wide#: point21(1) = zxxsp + crf#: point21(2) = 0#
point22(0) = zbjl + wide#: point22(1) = zxxsp - crf#: point22(2) = 0#

location2(0) = zbjl + wide + 30#: location2(1) = 0#: location2(2) = 0#

'创建平行尺寸标注对象。
If Option6.Value = True Then
Set bz2 = acadapp.ActiveDocument.ModelSpace.AddDimAligned(point21, point22, location2)

Else
''''''''''''''''''''''''''''''''''自己写尺寸@@@@@@@@@@@@@@@
Set bz2 = acadapp.ActiveDocument.ModelSpace.AddDimAligned(point21, point22, location2)
Dim zbz2 As Integer
zbz2 = cm * (cz - 2.5)
bz2.TextOverride = "%%c" & zbz2

End If
                                        '标注公差。
bz2.DecimalSeparator = "."   '小数点符号。
'公差显示特性。
bz2.ToleranceDisplay = acTolSymmetrical  '对称显示公差。
bz2.TolerancePrecision = acDimPrecisionFour   '4位小数
bz2.ToleranceHeightScale = 0.5  '偏差文本高度为尺寸高度的一半。
'设置公差。
bz2.ToleranceLowerLimit = 0.015
bz2.ToleranceUpperLimit = 0.01

bz2.Update


Dim bz3 As AcadDimAligned             '''''''''腹板俩中心轴距离
Dim point31(0 To 2) As Double
Dim point32(0 To 2) As Double
Dim location3(0 To 2) As Double


'定义尺寸标注。
point31(0) = zbjl + wide + 10#: point31(1) = zxxsp + jl#: point31(2) = 0#
point32(0) = zbjl + wide + 10#: point32(1) = zxxsp - jl#: point32(2) = 0#

location3(0) = zbjl + wide + 20#: location3(1) = 0#: location3(2) = 0#

'创建平行尺寸标注对象。
If Option6.Value = True Then
Set bz3 = acadapp.ActiveDocument.ModelSpace.AddDimAligned(point31, point32, location3)

Else
''''''''''''''''''''''''''''''''''自己写尺寸@@@@@@@@@@@@@@@
Set bz3 = acadapp.ActiveDocument.ModelSpace.AddDimAligned(point31, point32, location3)
Dim zbz3 As Integer
zbz3 = cm * (