form024.frm

锥齿轮CAD设计

Dim del1 As Double          '
Dim l As Double             '齿轮宽
Dim d0 As Double            'd0
Dim d1 As Double            'd1
Dim d2 As Double            'd2
Dim d3 As Double            'D3
Dim d4 As Double            'd4轴直径
                            ''''''''''''''''''''角
Dim a1 As Double             '分锥角
Dim aa1 As Double            '顶锥角
Dim af1 As Double            '根锥角
Dim setf As Double           '齿根角

Dim zfbk As Double           '左腹板宽
Dim yfbk As Double           '右腹板宽
Dim zb As Double             '左边伸出量



d = Text1.Text
zxxsp = tzg / 2 + 20
zxxy = tzc - 2 * e - cra - 40            '3 * tkc / 8
dj = 2
ndj = 2
ybjl = zxxy
r = (cm / 2) * Sqr(cz ^ 2 + czd ^ 2)
bb = Int(r / 3)              ''''''''b<=(r/3)取整
cc = 0.25 * bb
del1 = 0.15 * bb
da = 2 * cra
d4 = d
d3 = 1.6 * d4
d0 = da - 12 * cm
d1 = (d0 + d3) / 2
d2 = 0.3 * (d0 - d3)
               '钢材

setf = Atn(1.2 * cm / r)
a1 = Atn(cz / czd)
aa1 = a1 + setf
af1 = a1 - setf

l = 1.2 * d4


''''''''''''''''''
zfbk = 10
yfbk = 20
zb = 5


''''''''''''''''''''

If Option5.Value Then
zbjl = 60
End If

If Option4.Value Then
zbjl = 100
End If

If Option3.Value Then
zbjl = 120
End If

If Option2.Value Then
zbjl = 150
End If

If Option1.Value Then
zbjl = 160
End If


                                             ''''''''''''''''轴孔
Dim jk As AcadLine
Dim startpointjk(0 To 2) As Double
Dim endpointjk(0 To 2) As Double
startpointjk(0) = zbjl - zb#: startpointjk(1) = zxxsp + d4 / 2 + ndj#: startpointjk(2) = 0#
endpointjk(0) = zbjl - zb + ndj#: endpointjk(1) = zxxsp + d4 / 2#: endpointjk(2) = 0#
Set jk = acadapp.ActiveDocument.ModelSpace.AddLine(startpointjk, endpointjk)

Dim kl As AcadLine
Dim startpointkl(0 To 2) As Double
Dim endpointkl(0 To 2) As Double
startpointkl(0) = zbjl - zb + ndj#: startpointkl(1) = zxxsp + d4 / 2#: startpointkl(2) = 0#
endpointkl(0) = zbjl + l - zb - ndj#: endpointkl(1) = zxxsp + d4 / 2#: endpointkl(2) = 0#
Set kl = acadapp.ActiveDocument.ModelSpace.AddLine(startpointkl, endpointkl)

Dim lm As AcadLine
Dim startpointlm(0 To 2) As Double
Dim endpointlm(0 To 2) As Double
startpointlm(0) = zbjl + l - zb - ndj#: startpointlm(1) = zxxsp + d4 / 2#: startpointlm(2) = 0#
endpointlm(0) = zbjl + l - zb#: endpointlm(1) = zxxsp + d4 / 2 + ndj#: endpointlm(2) = 0#
Set lm = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlm, endpointlm)

Dim no As AcadLine
Dim startpointno(0 To 2) As Double
Dim endpointno(0 To 2) As Double
startpointno(0) = zbjl + l - zb#: startpointno(1) = zxxsp - d4 / 2 - ndj#: startpointno(2) = 0#
endpointno(0) = zbjl + l - zb - ndj#: endpointno(1) = zxxsp - d4 / 2#: endpointno(2) = 0#
Set no = acadapp.ActiveDocument.ModelSpace.AddLine(startpointno, endpointno)

Dim op As AcadLine
Dim startpointop(0 To 2) As Double
Dim endpointop(0 To 2) As Double
startpointop(0) = zbjl + l - zb - ndj#: startpointop(1) = zxxsp - d4 / 2#: startpointop(2) = 0#
endpointop(0) = zbjl - zb + ndj#: endpointop(1) = zxxsp - d4 / 2#: endpointop(2) = 0#
Set op = acadapp.ActiveDocument.ModelSpace.AddLine(startpointop, endpointop)

Dim pq As AcadLine
Dim startpointpq(0 To 2) As Double
Dim endpointpq(0 To 2) As Double
startpointpq(0) = zbjl - zb + ndj#: startpointpq(1) = zxxsp - d4 / 2#: startpointpq(2) = 0#
endpointpq(0) = zbjl - zb#: endpointpq(1) = zxxsp - d4 / 2 - ndj#: endpointpq(2) = 0#
Set pq = acadapp.ActiveDocument.ModelSpace.AddLine(startpointpq, endpointpq)


Dim kp As AcadLine
Dim startpointkp(0 To 2) As Double
Dim endpointkp(0 To 2) As Double
startpointkp(0) = zbjl - zb + ndj#: startpointkp(1) = zxxsp + d4 / 2#: startpointkp(2) = 0#
endpointkp(0) = zbjl - zb + ndj#: endpointkp(1) = zxxsp - d4 / 2#: endpointkp(2) = 0#
Set kp = acadapp.ActiveDocument.ModelSpace.AddLine(startpointkp, endpointkp)

Dim lo As AcadLine
Dim startpointlo(0 To 2) As Double
Dim endpointlo(0 To 2) As Double
startpointlo(0) = zbjl + l - zb - ndj#: startpointlo(1) = zxxsp + d4 / 2#: startpointlo(2) = 0#
endpointlo(0) = zbjl + l - zb - ndj#: endpointlo(1) = zxxsp - d4 / 2#: endpointlo(2) = 0#
Set lo = acadapp.ActiveDocument.ModelSpace.AddLine(startpointlo, endpointlo)

 

                                                ''''''''''''''''''右视图
Dim njk As AcadCircle          '内径孔
Dim centerpointnjk(0 To 2) As Double
centerpointnjk(0) = ybjl#: centerpointnjk(1) = zxxsp#: centerpointnjk(2) = 0#:
Set njk = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointnjk, d4 / 2)

njk.Lineweight = acLnWt30

Dim njkdj As AcadCircle         '内径孔倒角
Dim centerpointnjkdj(0 To 2) As Double
centerpointnjkdj(0) = ybjl#: centerpointnjkdj(1) = zxxsp#: centerpointnjkdj(2) = 0#:
Set njkdj = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointnjkdj, d4 / 2 + ndj)

njkdj.Lineweight = acLnWt30

Dim zwj As AcadCircle         '轴外径
Dim centerpointzwj(0 To 2) As Double
centerpointzwj(0) = ybjl#: centerpointzwj(1) = zxxsp#: centerpointzwj(2) = 0#:
Set zwj = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointzwj, d3 / 2)

zwj.Lineweight = acLnWt30

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 ncdy As AcadCircle         '内齿顶圆
Dim centerpointncdy(0 To 2) As Double
centerpointncdy(0) = ybjl#: centerpointncdy(1) = zxxsp#: centerpointncdy(2) = 0#:
Set ncdy = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointncdy, cra - Sin(aa1) * bb)

ncdy.Lineweight = acLnWt30

Dim ncgy As AcadCircle         '内齿根圆
Dim centerpointncgy(0 To 2) As Double
centerpointncgy(0) = ybjl#: centerpointncgy(1) = zxxsp#: centerpointncgy(2) = 0#:
Set ncgy = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointncgy, crf - Sin(af1) * bb)

ncgy.Lineweight = acLnWt30

                               '''''''''''四个小圆
Dim xy1 As AcadCircle     '上
Dim centerpointxy1(0 To 2) As Double
centerpointxy1(0) = ybjl#: centerpointxy1(1) = zxxsp + d1 / 2#: centerpointxy1(2) = 0#:
Set xy1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointxy1, d2 / 2)

xy1.Lineweight = acLnWt30

Dim xy2 As AcadCircle     '下
Dim centerpointxy2(0 To 2) As Double
centerpointxy2(0) = ybjl#: centerpointxy2(1) = zxxsp - d1 / 2#: centerpointxy2(2) = 0#:
Set xy2 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointxy2, d2 / 2)

xy2.Lineweight = acLnWt30

Dim xy3 As AcadCircle     '左
Dim centerpointxy3(0 To 2) As Double
centerpointxy3(0) = ybjl - d1 / 2#: centerpointxy3(1) = zxxsp#: centerpointxy3(2) = 0#:
Set xy3 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointxy3, d2 / 2)

xy3.Lineweight = acLnWt30

Dim xy4 As AcadCircle     '右
Dim centerpointxy4(0 To 2) As Double
centerpointxy4(0) = ybjl + d1 / 2#: centerpointxy4(1) = zxxsp#: centerpointxy4(2) = 0#:
Set xy4 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpointxy4, d2 / 2)

xy4.Lineweight = acLnWt30

                                   ''''''''''''''''''''左视图

Dim z12 As AcadLine
Dim startpointz12(0 To 1) As Double
Dim endpointz12(0 To 1) As Double
startpointz12(0) = zbjl#: startpointz12(1) = zxxsp - Sin(aa1) * bb + cra#: startpointz12(1) = 0#
endpointz12(0) = zbjl + Cos(aa1) * bb#: endpointz12(1) = zxxsp + cra#: startpointz12(1) = 0#
Set z12 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz12, endpointz12)

Dim z24 As AcadLine
Dim startpointz24(0 To 2) As Double
Dim endpointz24(0 To 2) As Double
startpointz24(0) = zbjl + Cos(aa1) * bb#: startpointz24(1) = zxxsp + cra#: startpointz24(2) = 0#
endpointz24(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: endpointz24(1) = zxxsp + crf - Cos(a1) * del1#: endpointz24(2) = 0#
Set z24 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz24, endpointz24)

Dim z47 As AcadLine
Dim startpointz47(0 To 1) As Double
Dim endpointz47(0 To 1) As Double
startpointz47(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: startpointz47(1) = zxxsp + crf - Cos(a1) * del1#: startpointz47(1) = 0#
endpointz47(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: endpointz47(1) = zxxsp + d3 / 2#: startpointz47(1) = 0#
Set z47 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz47, endpointz47)

Dim z45 As AcadLine
Dim startpointz45(0 To 1) As Double
Dim endpointz45(0 To 1) As Double
startpointz45(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: startpointz45(1) = zxxsp + crf - Cos(a1) * del1#: startpointz45(1) = 0#
endpointz45(0) = zbjl + zfbk + cc#: endpointz45(1) = zxxsp + crf - Cos(a1) * del1 - Tan(af1) * yfbk#: startpointz45(1) = 0#
Set z45 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz45, endpointz45)

Dim z56 As AcadLine
Dim startpointz56(0 To 1) As Double
Dim endpointz56(0 To 1) As Double
startpointz56(0) = zbjl + zfbk + cc#: startpointz56(1) = zxxsp + crf - Cos(a1) * del1 - Tan(af1) * yfbk#: startpointz56(1) = 0#
endpointz56(0) = zbjl + zfbk + cc#: endpointz56(1) = zxxsp + d3 / 2#: startpointz56(1) = 0#
Set z56 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz56, endpointz56)

Dim z68 As AcadLine
Dim startpointz68(0 To 1) As Double
Dim endpointz68(0 To 1) As Double
startpointz68(0) = zbjl + zfbk + cc#: startpointz68(1) = zxxsp + d3 / 2#: startpointz68(1) = 0#
endpointz68(0) = zbjl + l#: endpointz68(1) = zxxsp + d3 / 2#: startpointz68(1) = 0#
Set z68 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz68, endpointz68)

Dim z89 As AcadLine
Dim endpointz89(0 To 1) As Double
Dim startpointz89(0 To 1) As Double
startpointz89(0) = zbjl + l#: startpointz89(1) = zxxsp + d3 / 2#: startpointz89(1) = 0#
endpointz89(0) = zbjl + l#: endpointz89(1) = zxxsp - d3 / 2#: startpointz89(1) = 0#
Set z89 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz89, endpointz89)

Dim z911 As AcadLine
Dim startpointz911(0 To 1) As Double
Dim endpointz911(0 To 1) As Double
startpointz911(0) = zbjl + l#: startpointz911(1) = zxxsp - d3 / 2#: startpointz911(1) = 0#
endpointz911(0) = zbjl + zfbk + cc#: endpointz911(1) = zxxsp - d3 / 2#: startpointz911(1) = 0#
Set z911 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz911, endpointz911)

Dim z1112 As AcadLine
Dim startpointz1112(0 To 1) As Double
Dim endpointz1112(0 To 1) As Double
startpointz1112(0) = zbjl + zfbk + cc#: startpointz1112(1) = zxxsp - d3 / 2#: startpointz1112(1) = 0#
endpointz1112(0) = zbjl + zfbk + cc#: endpointz1112(1) = zxxsp - crf + Cos(a1) * del1 + Tan(af1) * yfbk#: startpointz1112(1) = 0#
Set z1112 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1112, endpointz1112)

Dim z1213 As AcadLine
Dim startpointz1213(0 To 1) As Double
Dim endpointz1213(0 To 1) As Double
startpointz1213(0) = zbjl + zfbk + cc#: startpointz1213(1) = zxxsp - crf + Cos(a1) * del1 + Tan(af1) * yfbk#: startpointz1213(1) = 0#
endpointz1213(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: endpointz1213(1) = zxxsp - crf + Cos(a1) * del1#: startpointz1213(1) = 0#
Set z1213 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1213, endpointz1213)

Dim z1013 As AcadLine
Dim startpointz1013(0 To 1) As Double
Dim endpointz1013(0 To 1) As Double
startpointz1013(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: startpointz1013(1) = zxxsp - d3 / 2#: startpointz1013(1) = 0#
endpointz1013(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: endpointz1013(1) = zxxsp - crf + Cos(a1) * del1#: startpointz1013(1) = 0#
Set z1013 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1013, endpointz1013)

Dim z1315 As AcadLine
Dim startpointz1315(0 To 1) As Double
Dim endpointz1315(0 To 1) As Double
startpointz1315(0) = zbjl + Cos(aa1) * bb + 2.2 * Tan(a1) * cm#: startpointz1315(1) = zxxsp - crf + Cos(a1) * del1#: startpointz1315(1) = 0#
endpointz1315(0) = zbjl + Cos(aa1) * bb#: endpointz1315(1) = zxxsp - cra#: startpointz1315(1) = 0#
Set z1315 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1315, endpointz1315)

Dim z1516 As AcadLine
Dim startpointz1516(0 To 1) As Double
Dim endpointz1516(0 To 1) As Double
startpointz1516(0) = zbjl + Cos(aa1) * bb#: startpointz1516(1) = zxxsp - cra#: startpointz1516(1) = 0#
endpointz1516(0) = zbjl#: endpointz1516(1) = zxxsp + Sin(aa1) * bb - cra#: startpointz1516(1) = 0#
Set z1516 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1516, endpointz1516)

Dim z1617 As AcadLine
Dim startpointz1617(0 To 1) As Double
Dim endpointz1617(0 To 1) As Double
startpointz1617(0) = zbjl#: startpointz1617(1) = zxxsp - Sin(aa1) * bb + cra#: startpointz1617(1) = 0#
endpointz1617(0) = zbjl + zfbk#: endpointz1617(1) = zxxsp - crf + Sin(af1) * bb#: startpointz1617(1) = 0#
Set z1617 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1617, endpointz1617)

Dim z1619 As AcadLine
Dim startpointz1619(0 To 1) As Double
Dim endpointz1619(0 To 1) As Double
startpointz1619(0) = zbjl#: startpointz1619(1) = zxxsp - Sin(aa1) * bb + cra#: startpointz1619(1) = 0#
endpointz1619(0) = zbjl#: endpointz1619(1) = zxxsp - d3 / 2#: startpointz1619(1) = 0#
Set z1619 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1619, endpointz1619)

Dim z1718 As AcadLine
Dim startpointz1718(0 To 1) As Double
Dim endpointz1718(0 To 1) As Double
startpointz1718(0) = zbjl + zfbk#: startpointz1718(1) = zxxsp - crf + Sin(af1) * bb#: startpointz1718(1) = 0#
endpointz1718(0) = zbjl + zfbk#: endpointz1718(1) = zxxsp - d3 / 2#: startpointz1718(1) = 0#
Set z1718 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointz1718, endpointz1718)