form13.frm

很好的齿轮cad参数化设计程序

endpointy11(0) = d30#: endpointy11(1) = d27#: endpointy11(2) = 0#
Set y11 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy11, endpointy11)

Dim y12 As AcadLine
Dim startpointy12(0 To 2) As Double
Dim endpointy12(0 To 2) As Double
startpointy12(0) = d2#: startpointy12(1) = d28#: startpointy12(2) = 0#
endpointy12(0) = d30#: endpointy12(1) = d27#: endpointy12(2) = 0#
Set y12 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy12, endpointy12)

Dim y13 As AcadLine
Dim startpointy13(0 To 2) As Double
Dim endpointy13(0 To 2) As Double
startpointy13(0) = d29#: startpointy13(1) = d27#: startpointy13(2) = 0#
endpointy13(0) = d29#: endpointy13(1) = d26#: endpointy13(2) = 0#
Set y13 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy13, endpointy13)

Dim y14 As AcadLine
Dim startpointy14(0 To 2) As Double
Dim endpointy14(0 To 2) As Double
startpointy14(0) = d17#: startpointy14(1) = d27#: startpointy14(2) = 0#
endpointy14(0) = d17#: endpointy14(1) = d26#: endpointy14(2) = 0#
Set y14 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy14, endpointy14)

Dim y15 As AcadLine
Dim startpointy15(0 To 2) As Double
Dim endpointy15(0 To 2) As Double
startpointy15(0) = d17#: startpointy15(1) = d33#: startpointy15(2) = 0#
endpointy15(0) = d18#: endpointy15(1) = d33#: endpointy15(2) = 0#
Set y15 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy15, endpointy15)

Dim y16 As AcadLine
Dim startpointy16(0 To 2) As Double
Dim endpointy16(0 To 2) As Double
startpointy16(0) = d18#: startpointy16(1) = d27#: startpointy16(2) = 0#
endpointy16(0) = d18#: endpointy16(1) = d26#: endpointy16(2) = 0#
Set y16 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy16, endpointy16)

Dim y17 As AcadLine
Dim startpointy17(0 To 2) As Double
Dim endpointy17(0 To 2) As Double
startpointy17(0) = d30#: startpointy17(1) = d26#: startpointy17(2) = 0#
endpointy17(0) = d30#: endpointy17(1) = d27#: endpointy17(2) = 0#
Set y17 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy17, endpointy17)

Dim y18 As AcadLine
Dim startpointy18(0 To 2) As Double
Dim endpointy18(0 To 2) As Double
startpointy18(0) = d30#: startpointy18(1) = d26#: startpointy18(2) = 0#
endpointy18(0) = d2#: endpointy18(1) = d38#: endpointy18(2) = 0#
Set y18 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy18, endpointy18)

Dim y19 As AcadLine
Dim startpointy19(0 To 2) As Double
Dim endpointy19(0 To 2) As Double
startpointy19(0) = d30#: startpointy19(1) = d26#: startpointy19(2) = 0#
endpointy19(0) = d18#: endpointy19(1) = d26#: endpointy19(2) = 0#
Set y19 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy19, endpointy19)

Dim y20 As AcadLine
Dim startpointy20(0 To 2) As Double
Dim endpointy20(0 To 2) As Double
startpointy20(0) = d17#: startpointy20(1) = d26#: startpointy20(2) = 0#
endpointy20(0) = d29#: endpointy20(1) = d26#: endpointy20(2) = 0#
Set y20 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy20, endpointy20)

Dim y21 As AcadLine
Dim startpointy21(0 To 2) As Double
Dim endpointy21(0 To 2) As Double
startpointy21(0) = d1#: startpointy21(1) = d38#: startpointy21(2) = 0#
endpointy21(0) = d29#: endpointy21(1) = d26#: endpointy21(2) = 0#
Set y21 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy21, endpointy21)

Dim y23 As AcadLine
Dim startpointy23(0 To 2) As Double
Dim endpointy23(0 To 2) As Double
startpointy23(0) = d35#: startpointy23(1) = d9#: startpointy23(2) = 0#
endpointy23(0) = d36#: endpointy23(1) = d9#: endpointy23(2) = 0#
Set y23 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy23, endpointy23)

Dim y24 As AcadLine
Dim startpointy24(0 To 2) As Double
Dim endpointy24(0 To 2) As Double
startpointy24(0) = d1#: startpointy24(1) = d25#: startpointy24(2) = 0#
endpointy24(0) = d35#: endpointy24(1) = d9#: endpointy24(2) = 0#
Set y24 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy24, endpointy24)

Dim y25 As AcadLine
Dim startpointy25(0 To 2) As Double
Dim endpointy25(0 To 2) As Double
startpointy25(0) = d36#: startpointy25(1) = d9#: startpointy25(2) = 0#
endpointy25(0) = d2#: endpointy25(1) = d25#: endpointy25(2) = 0#
Set y25 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy25, endpointy25)

Dim y26 As AcadLine
Dim startpointy26(0 To 2) As Double
Dim endpointy26(0 To 2) As Double
startpointy26(0) = d35#: startpointy26(1) = d3#: startpointy26(2) = 0#
endpointy26(0) = d36#: endpointy26(1) = d3#: endpointy26(2) = 0#
Set y26 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy26, endpointy26)

Dim y27 As AcadLine
Dim startpointy27(0 To 2) As Double
Dim endpointy27(0 To 2) As Double
startpointy27(0) = d1#: startpointy27(1) = d19#: startpointy27(2) = 0#
endpointy27(0) = d35#: endpointy27(1) = d3#: endpointy27(2) = 0#
Set y27 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy27, endpointy27)

Dim y28 As AcadLine
Dim startpointy28(0 To 2) As Double
Dim endpointy28(0 To 2) As Double
startpointy28(0) = d36#: startpointy28(1) = d3#: startpointy28(2) = 0#
endpointy28(0) = d2#: endpointy28(1) = d19#: endpointy28(2) = 0#
Set y28 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy28, endpointy28)

Dim y29 As AcadLine
Dim startpointy29(0 To 2) As Double
Dim endpointy29(0 To 2) As Double
startpointy29(0) = d29#: startpointy29(1) = d21#: startpointy29(2) = 0#
endpointy29(0) = d17#: endpointy29(1) = d21#: endpointy29(2) = 0#
Set y29 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy29, endpointy29)

Dim y30 As AcadLine
Dim startpointy30(0 To 2) As Double
Dim endpointy30(0 To 2) As Double
startpointy30(0) = d17#: startpointy30(1) = d32#: startpointy30(2) = 0#
endpointy30(0) = d18#: endpointy30(1) = d32#: endpointy30(2) = 0#
Set y30 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy30, endpointy30)

Dim y31 As AcadLine
Dim startpointy31(0 To 2) As Double
Dim endpointy31(0 To 2) As Double
startpointy31(0) = d18#: startpointy31(1) = d21#: startpointy31(2) = 0#
endpointy31(0) = d30#: endpointy31(1) = d21#: endpointy31(2) = 0#
Set y31 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy31, endpointy31)

Dim y32 As AcadLine
Dim startpointy32(0 To 2) As Double
Dim endpointy32(0 To 2) As Double
startpointy32(0) = d30#: startpointy32(1) = d21#: startpointy32(2) = 0#
endpointy32(0) = d2#: endpointy32(1) = d20#: endpointy32(2) = 0#
Set y32 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy32, endpointy32)

Dim y33 As AcadLine
Dim startpointy33(0 To 2) As Double
Dim endpointy33(0 To 2) As Double
startpointy33(0) = d1#: startpointy33(1) = d20#: startpointy33(2) = 0#
endpointy33(0) = d29#: endpointy33(1) = d21#: endpointy33(2) = 0#
Set y33 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy33, endpointy33)

Dim y34 As AcadLine
Dim startpointy34(0 To 2) As Double
Dim endpointy34(0 To 2) As Double
startpointy34(0) = d29#: startpointy34(1) = d21#: startpointy34(2) = 0#
endpointy34(0) = d29#: endpointy34(1) = d23#: endpointy34(2) = 0#
Set y34 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy34, endpointy34)

Dim y35 As AcadLine
Dim startpointy35(0 To 2) As Double
Dim endpointy35(0 To 2) As Double
startpointy35(0) = d17#: startpointy35(1) = d21#: startpointy35(2) = 0#
endpointy35(0) = d17#: endpointy35(1) = d23#: endpointy35(2) = 0#
Set y35 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy35, endpointy35)

Dim y36 As AcadLine
Dim startpointy36(0 To 2) As Double
Dim endpointy36(0 To 2) As Double
startpointy36(0) = d18#: startpointy36(1) = d21#: startpointy36(2) = 0#
endpointy36(0) = d18#: endpointy36(1) = d23#: endpointy36(2) = 0#
Set y36 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy36, endpointy36)

Dim y37 As AcadLine
Dim startpointy37(0 To 2) As Double
Dim endpointy37(0 To 2) As Double
startpointy37(0) = d30#: startpointy37(1) = d23#: startpointy37(2) = 0#
endpointy37(0) = d30#: endpointy37(1) = d21#: endpointy37(2) = 0#
Set y37 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy37, endpointy37)

Dim y38 As AcadLine
Dim startpointy38(0 To 2) As Double
Dim endpointy38(0 To 2) As Double
startpointy38(0) = d29#: startpointy38(1) = d23#: startpointy38(2) = 0#
endpointy38(0) = d17#: endpointy38(1) = d23#: endpointy38(2) = 0#
Set y38 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy38, endpointy38)

Dim y39 As AcadLine
Dim startpointy39(0 To 2) As Double
Dim endpointy39(0 To 2) As Double
startpointy39(0) = d29#: startpointy39(1) = d23#: startpointy39(2) = 0#
endpointy39(0) = d1#: endpointy39(1) = d24#: endpointy39(2) = 0#
Set y39 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy39, endpointy39)

Dim y40 As AcadLine
Dim startpointy40(0 To 2) As Double
Dim endpointy40(0 To 2) As Double
startpointy40(0) = d17#: startpointy40(1) = d31#: startpointy40(2) = 0#
endpointy40(0) = d18#: endpointy40(1) = d31#: endpointy40(2) = 0#
Set y40 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy40, endpointy40)

Dim y41 As AcadLine
Dim startpointy41(0 To 2) As Double
Dim endpointy41(0 To 2) As Double
startpointy41(0) = d18#: startpointy41(1) = d23#: startpointy41(2) = 0#
endpointy41(0) = d30#: endpointy41(1) = d23#: endpointy41(2) = 0#
Set y41 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy41, endpointy41)

Dim y42 As AcadLine
Dim startpointy42(0 To 2) As Double
Dim endpointy42(0 To 2) As Double
startpointy42(0) = d30#: startpointy42(1) = d23#: startpointy42(2) = 0#
endpointy42(0) = d2#: endpointy42(1) = d24#: endpointy42(2) = 0#
Set y42 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy42, endpointy42)

Dim y43 As AcadLine
Dim startpointy43(0 To 2) As Double
Dim endpointy43(0 To 2) As Double
startpointy43(0) = d1#: startpointy43(1) = d4#: startpointy43(2) = 0#
endpointy43(0) = d2#: endpointy43(1) = d4#: endpointy43(2) = 0#
Set y43 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy43, endpointy43)

'Dim y44 As AcadLine 'zhong xin xian
'Dim startpointy44(0 To 2) As Double
'Dim endpointy44(0 To 2) As Double
'startpointy44(0) = d15#: startpointy44(1) = d5#: startpointy44(2) = 0#
'endpointy44(0) = d16#: endpointy44(1) = d5#: endpointy44(2) = 0#
'Set y44 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy44, endpointy44)

Dim y45 As AcadLine
Dim startpointy45(0 To 2) As Double
Dim endpointy45(0 To 2) As Double
startpointy45(0) = d2#: startpointy45(1) = d13#: startpointy45(2) = 0#
endpointy45(0) = d8#: endpointy45(1) = d6#: endpointy45(2) = 0#
Set y45 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy45, endpointy45)

Dim y46 As AcadLine
Dim startpointy46(0 To 2) As Double
Dim endpointy46(0 To 2) As Double
startpointy46(0) = d7#: startpointy46(1) = d6#: startpointy46(2) = 0#
endpointy46(0) = d8#: endpointy46(1) = d6#: endpointy46(2) = 0#
Set y46 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy46, endpointy46)

Dim y47 As AcadLine
Dim startpointy47(0 To 2) As Double
Dim endpointy47(0 To 2) As Double
startpointy47(0) = d1#: startpointy47(1) = d13#: startpointy47(2) = 0#
endpointy47(0) = d7#: endpointy47(1) = d6#: endpointy47(2) = 0#
Set y47 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy47, endpointy47)

Dim y48 As AcadLine
Dim startpointy48(0 To 2) As Double
Dim endpointy48(0 To 2) As Double
startpointy48(0) = d35#: startpointy48(1) = d9#: startpointy48(2) = 0#
endpointy48(0) = d35#: endpointy48(1) = d3#: endpointy48(2) = 0#
Set y48 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy48, endpointy48)

Dim y49 As AcadLine
Dim startpointy49(0 To 2) As Double
Dim endpointy49(0 To 2) As Double
startpointy49(0) = d36#: startpointy49(1) = d3#: startpointy49(2) = 0#
endpointy49(0) = d36#: endpointy49(1) = d9#: endpointy49(2) = 0#
Set y49 = acadapp.ActiveDocument.ModelSpace.AddLine(startpointy49, endpointy49)

y1.Lineweight = acLnWt030
y2.Lineweight = acLnWt030
y3.Lineweight = acLnWt030
'y4.Lineweight = acLnWt030
y5.Lineweight = acLnWt030
y6.Lineweight = acLnWt030
y7.Lineweight = acLnWt030
y8.Lineweight = acLnWt030
y9.Lineweight = acLnWt030
y10.Lineweight = acLnWt030
y11.Lineweight = acLnWt030
y12.Lineweight = acLnWt030
y13.Lineweight = acLnWt030
y14.Lineweight = acLnWt030
y15.Lineweight = acLnWt030
y16.Lineweight = acLnWt030
y17.Lineweight = acLnWt030
y18.Lineweight = acLnWt030
y19.Lineweight = acLnWt030
y20.Lineweight = acLnWt030
y21.Lineweight = acLnWt030
'y22.Lineweight = acLnWt030
y23.Lineweight = acLnWt030
y24.Lineweight = acLnWt030
y25.Lineweight = acLnWt030
y26.Lineweight = acLnWt030
y27.Lineweight = acLnWt030
y28.Lineweight = acLnWt030
y29.Lineweight = acLnWt030
y30.Lineweight = acLnWt030
y31.Lineweight = acLnWt030
y32.Lineweight = acLnWt030
y34.Lineweight = acLnWt030
y34.Lineweight = acLnWt030
y35.Lineweight = acLnWt030
y36.Lineweight = acLnWt030
y37.Lineweight = acLnWt030
y38.Lineweight = acLnWt030
y39.Lineweight = acLnWt030
y40.Lineweight = acLnWt030
y41.Lineweight = acLnWt030
y42.Lineweight = acLnWt030
y43.Lineweight = acLnWt030
'y44.Lineweight = acLnWt030
y45.Lineweight = acLnWt030
y46.Lineweight = acLnWt030
y47.Lineweight = acLnWt030
y48.Lineweight = acLnWt030
y49.Lineweight = acLnWt030
'y481.Lineweight = acLnWt030
'y491.Lineweight = acLnWt030







'画左视图。

'画齿顶圆（粗实线）

Dim cdy1 As AcadCircle
'Dim centerpointj(0 To 2) As Double
'centerpointj(0) = zxx07#: centerpointj(1) = zxx06#: centerpointj(2) = 0#:
Set cdy1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, cra)

cdy1.Lineweight = acLnWt030

'画齿顶倒角圆。
Dim djy1 As AcadCircle
Dim djybj1 As Double
djybj1 = cra - 2
Set djy1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, djybj1)
djy1.Lineweight = acLnWt030



'画齿跟圆（粗实线）

'Dim cgy As AcadCircle
'Set cgy = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, crf)

'cgy.Lineweight = acLnWt030

'画轴孔圆（粗实线）

Dim zk1 As AcadCircle
Set zk1 = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, cra / 3)

zk1.Lineweight = acLnWt030

'画轴孔倒角圆（粗实线）

Dim zkdjr As Double
zkdjr = cra / 3 + 2

Dim zkdj As AcadCircle
Set zkdj = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, zkdjr)

zkdj.Lineweight = acLnWt030

'画d1

Dim d1y As AcadCircle
Set d1y = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, vd1 / 2)

d1y.Lineweight = acLnWt030

'画d1倒角圆。

Dim d1djr As Double
d1djr = vd1 / 2 - 2

Dim d1dj As AcadCircle
Set d1dj = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, d1djr)

d1dj.Lineweight = acLnWt030

''画D0圆。（中心线）
'Dim dd0zy As AcadCircle
'Set dd0zy = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, vdd0 / 2)

'画D0上圆。（粗实线）

Dim dd0r As Double
dd0r = vdd0 / 2 + (vdd0 - vd1) / 2

Dim dd0y As AcadCircle
Set dd0y = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, dd0r)

dd0y.Lineweight = acLnWt030

'画D0上倒角圆。（粗实线）

Dim dd0djr As Double
dd0djr = vdd0 / 2 + (vdd0 - vd1) / 2 + 2

Dim dd0djy As AcadCircle
Set dd0djy = acadapp.ActiveDocument.ModelSpace.AddCircle(centerpoint, dd0djr)

dd0djy.Lineweight = acLnWt030

'画四个小圆。

Dim d01y As AcadCircle
Dim center