齐贤伟 基于AUTOCAD VBA渐开线斜齿轮参数化设计系统(9)

2019-09-01 18:41

安徽理工大学毕业设计

uuenp(0) = ddenp(0): uuenp(1) = uenp(1): uuenp(2) = 0 zstp(0) = cenp(0) - da / 2 - bb - 40: zstp(1) = cenp(1): zstp(2) = 0 Set utilobj = ThisDrawing.Utility

utilobj.CreateTypedArray cp, vbDouble, cenp(0), cenp(1), 0 ……………………………………………… ThisDrawing.ActiveLayer = layercen

Set cline1 = ThisDrawing.ModelSpace.AddLine(ucp, dcp) ……………………………………………… cline1.LinetypeScale = 20 cline2.LinetypeScale = 20 cline3.LinetypeScale = 20 cline4.LinetypeScale = 20

If UserForm8.OptionButton1.Value = True Then Set circled1 = ThisDrawing.ModelSpace.AddCircle(cp, d1 / 2)

If UserForm8.OptionButton2.Value = True Then Set circled1 = ThisDrawing.ModelSpace.AddCircle(cp, d2 / 2)

circled1.LinetypeScale = 20

ThisDrawing.ActiveLayer = layergear

Set circleda = ThisDrawing.ModelSpace.AddCircle(cp, da / 2) Set circledf = ThisDrawing.ModelSpace.AddCircle(cp, df / 2)

lgujcp(0) = cenp(0) - jcb / 2: lgujcp(1) = cenp(1) + Sqr(dd * dd / 4 - jcb * jcb / 4): lgujcp(2) = lgujcp(0): lgujcp(3) = cenp(1) + dd / 2 + jct1

lgujcp(4) = cenp(0) + jcb / 2: lgujcp(5) = lgujcp(3): lgujcp(6) = lgujcp(4): lgujcp(7) = lgujcp(1) Set lgujc = ThisDrawing.ModelSpace.AddLightWeightPolyline(lgujcp) lgucenp(0) = cenp(0): lgucenp(1) = cenp(1): lgucenp(2) = 0 x1 = jcb / dd

arcsin = Atn(x1 / Sqr(-x1 * x1 + 1))

angle1(0) = -3 / 2 * pi + arcsin: angle1(1) = 1 / 2 * pi - arcsin x2 = Atn((jcb / 2) / (Sqr(dd * dd / 4 - jcb * jcb / 4) + dj)) angle2(0) = -3 / 2 * pi + Atn(x2): angle2(1) = 1 / 2 * pi - Atn(x2)

Set lguarc1 = ThisDrawing.ModelSpace.AddArc(lgucenp, dd / 2, angle1(0), angle1(1)) Set lguarc2 = ThisDrawing.ModelSpace.AddArc(lgucenp, dd / 2 + dj, angle2(0), angle2(1)) Dim zstline1 As AcadLWPolyline Dim zstp1(15) As Double

36

安徽理工大学毕业设计

zstp1(0) = zstp(0): zstp1(1) = zstp(1) + da / 2 - dj: zstp1(2) = zstp(0) + dj: zstp1(3) = zstp(1) + da / 2 zstp1(4) = zstp(0) + bb - dj: zstp1(5) = zstp1(3): zstp1(6) = zstp1(0) + bb: zstp1(7) = zstp1(1) zstp1(8) = zstp1(6): zstp1(9) = zstp(1) - da / 2 + dj: zstp1(10) = zstp1(4): zstp1(11) = zstp(1) - da / 2 zstp1(12) = zstp1(2): zstp1(13) = zstp1(11): zstp1(14) = zstp1(0): zstp1(15) = zstp1(9) Set zstline1 = ThisDrawing.ModelSpace.AddLightWeightPolyline(zstp1) zstline1.Closed = True

Dim fduline1 As AcadLine, fduline2 As AcadLine Dim fdup(3) As Double

If UserForm8.OptionButton1.Value = True Then fdup(0) = zstp(0) - 10: fdup(1) = zstp(0) + bb + 10 fdup(2) = zstp(1) + d1 / 2: fdup(3) = zstp(1) - d1 / 2 End If

If UserForm8.OptionButton2.Value = True Then fdup(0) = zstp(0) - 10: fdup(1) = zstp(0) + bb + 10 fdup(2) = zstp(1) + d2 / 2: fdup(3) = zstp(1) - d2 / 2 End If

utilobj.CreateTypedArray fdup02, vbDouble, fdup(0), fdup(2), 0 utilobj.CreateTypedArray fdup12, vbDouble, fdup(1), fdup(2), 0 utilobj.CreateTypedArray fdup03, vbDouble, fdup(0), fdup(3), 0 utilobj.CreateTypedArray fdup13, vbDouble, fdup(1), fdup(3), 0 ThisDrawing.ActiveLayer = layercen

Set fduline1 = ThisDrawing.ModelSpace.AddLine(fdup02, fdup12) Set fduline2 = ThisDrawing.ModelSpace.AddLine(fdup03, fdup13) fduline1.LinetypeScale = 20 fduline2.LinetypeScale = 20

ThisDrawing.ActiveLayer = layergear ………………………………………………

stanpoint(0) = zstp(0) - 3: stanpoint(1) = zstp(1) + dd / 2 + jct1: stanpoint(2) = 0 etanpoint(0) = zstp(0) + bb: etanpoint(1) = stanpoint(1) + 1: etanpoint(2) = 0 Set splineobj = ThisDrawing.ModelSpace.AddSpline(vetpoint, stanpoint, etanpoint) Set wpline1 = ThisDrawing.ModelSpace.AddLine(vetp1, vetp2) Set wpline2 = ThisDrawing.ModelSpace.AddLine(vetp3, vetp4) ThisDrawing.ActiveLayer = layergear Dim podpline As AcadLWPolyline

37

安徽理工大学毕业设计

Dim podp(7) As Double

podp(0) = zstp(0): podp(1) = vetpoint(1): podp(2) = zstp(0): podp(3) = zstp(1) + dd / 2 + jct1 podp(4) = zstp(0) + bb: podp(5) = podp(3): podp(6) = podp(4): podp(7) = vetpoint(13) Set podpline = ThisDrawing.ModelSpace.AddLightWeightPolyline(podp) ………………………………………………

poup(0) = zstp(0) + dj: poup(1) = zstp(1) - dd / 2: poup(2) = zstp(0): poup(3) = poup(1) - dj poup(4) = zstp(0): poup(5) = zstp(1) - df / 2: poup(6) = zstp(0) + bb: poup(7) = poup(5) poup(8) = poup(6): poup(9) = poup(3): poup(10) = poup(6) - dj: poup(11) = poup(1) Set poupline = ThisDrawing.ModelSpace.AddLightWeightPolyline(poup) poupline.Closed = True

……………………………………

lgu(0) = zstp(0): lgu(1) = zstp(1) + Sqr(dd * dd / 4 - jcb * jcb / 4) + dj: lgu(2) = zstp(0) + dj: lgu(3) = zstp(1) + Sqr(dd * dd / 4 - jcb * jcb / 4)

lgu(4) = zstp(0) + bb - dj: lgu(5) = lgu(3): lgu(6) = zstp(0) + bb: lgu(7) = lgu(1) Set jianchaoline = ThisDrawing.ModelSpace.AddLightWeightPolyline(lgu) utilobj.CreateTypedArray lgu11, vbDouble, lgu(2), lgu(3), 0 utilobj.CreateTypedArray lgu12, vbDouble, lgu(4), lgu(5), 0 utilobj.CreateTypedArray lgu21, vbDouble, poup(0), poup(1), 0 utilobj.CreateTypedArray lgu22, vbDouble, poup(10), poup(11), 0 Set lgudjline1 = ThisDrawing.ModelSpace.AddLine(lgu11, lgu21) Set lgudjline2 = ThisDrawing.ModelSpace.AddLine(lgu12, lgu22) Dim lxx(1) As Double, lxy(5) As Double

Dim lxline1 As AcadLine, lxline2 As AcadLine, lxline3 As AcadLine, lxline4 As AcadLine, lxline5 _ As AcadLine, lxline6 As AcadLine lxx(0) = zstp(0): lxx(1) = zstp(0) + bb

lxy(0) = zstp(1) + dd / 2 + jct1 + 2: lxy(1) = lxy(0) + 0.5: lxy(2) = lxy(0) + 1 lxy(3) = lxy(0) + bb * Sin(β): lxy(4) = lxy(3) + 0.5: lxy(5) = lxy(3) + 1 utilobj.CreateTypedArray lx00, vbDouble, lxx(0), lxy(0), 0 ThisDrawing.ActiveLayer = layerpou …………………………………… patternname = \ patterntype = 0 patternsp = d1 / 60 Set polyobj1(0) = podpline

38

安徽理工大学毕业设计

Set polyobj1(1) = splineobj

Set hatchobj1 = ThisDrawing.ModelSpace.AddHatch(patterntype, patternname, True) hatchobj1.AppendInnerLoop (polyobj1) hatchobj1.PatternScale = patternsp hatchobj1.Evaluate

Set polyobj2(0) = poupline

Set hatchobj2 = ThisDrawing.ModelSpace.AddHatch(patterntype, patternname, True) hatchobj2.AppendInnerLoop (polyobj2) hatchobj2.PatternScale = patternsp hatchobj2.Evaluate

ThisDrawing.Application.ZoomExtents Dim leaderdimobj As AcadLeader Dim leadpt(8) As Double Dim leaddimtype As Integer Dim leaddimtext As AcadObject

leadpt(0) = zstp(0) + 10: leadpt(1) = zstp(1) + da / 2: leadpt(2) = 0 leadpt(3) = zstp(0) + 10: leadpt(4) = zstp(1) + da / 2 + 20: leadpt(5) = 0 leadpt(6) = zstp(0) + 20: leadpt(7) = zstp(1) + da / 2 + 20: leadpt(8) = 0 leaddimtype = acLineWithArrow leaderdimobj.ArrowheadSize = 30 Set leaddimtext = Null

Set leaderdimobj = ThisDrawing.ModelSpace.AddLeader(leadpt, leaddimtext, leaddimtype) Dim leadpt1(8) As Double

leadpt1(0) = zstp(0) + bb: leadpt1(1) = zstp(1) - da / 2: leadpt1(2) = 0 leadpt1(3) = zstp(0) + 4 + bb: leadpt1(4) = zstp(1) - da / 2 - 30: leadpt1(5) = 0 leadpt1(6) = zstp(0) + 20 + bb: leadpt1(7) = zstp(1) - da / 2 - 30: leadpt1(8) = 0 Set leaddimtext = Null

Set leaderdimobj = ThisDrawing.ModelSpace.AddLeader(leadpt1, leaddimtext, leaddimtype) Dim leadpt3(8) As Double

leadpt3(0) = ins(0) + jcb / 2: leadpt3(1) = ins(1) + dd / 2 + 8: leadpt3(2) = 0 leadpt3(3) = ins(0) + jcb / 2 + 10: leadpt3(4) = ins(1) + dd / 2 + 8: leadpt3(5) = 0 leadpt3(6) = ins(0) + jcb / 2 + 40: leadpt3(7) = ins(1) + dd / 2 + 8: leadpt3(8) = 0 Set leaddimtext = Null

Set leaderdimobj = ThisDrawing.ModelSpace.AddLeader(leadpt3, leaddimtext, leaddimtype)

39

安徽理工大学毕业设计

……………………………………

tolerpt(0, 0) = zstp(0) + 20: tolerpt(0, 1) = zstp(1) + da / 2 + 20 directpt(0, 0) = zstp(0): directpt(0, 1) = 0

utilobj.CreateTypedArray tolerpt1, vbDouble, tolerpt(0, 0), tolerpt(0, 1), 0 utilobj.CreateTypedArray directpt1, vbDouble, directpt(0, 0), directpt(0, 1), 0 tolerstr(0) = \↗|0.022|A\

Set tolerobj = ThisDrawing.ModelSpace.AddTolerance(tolerstr(0), tolerpt1, directpt1) tolerobj.textheight = 5 tolerstr(1) = \↗|0.022|A\

tolerpt(1, 0) = zstp(0) + 20 + bb: tolerpt(1, 1) = zstp(1) - da / 2 - 30 directpt(1, 0) = zstp(0) + 30 + bb: directpt(1, 1) = 0

utilobj.CreateTypedArray tolerpt2, vbDouble, tolerpt(1, 0), tolerpt(1, 1), 0 utilobj.CreateTypedArray directpt2, vbDouble, directpt(1, 0), directpt(1, 1), 0 Set tolerobj = ThisDrawing.ModelSpace.AddTolerance(tolerstr(1), tolerpt2, directpt2) tolerobj.textheight = 5 ThisDrawing.ActiveLayer = layerdim Dim dimd As AcadDimAligned Dim dimdpoint1(2) As Double Dim dimdpoint2(2) As Double Dim dimlocation1(2) As Double

dimdpoint1(0) = zstp(0): dimdpoint1(1) = zstp(1) + da / 2: dimdpoint1(2) = 0 dimdpoint2(0) = zstp(0): dimdpoint2(1) = zstp(1) - da / 2: dimdpoint2(2) = 0 dimlocation1(0) = zstp(0) - 40: dimlocation1(1) = zstp(1): dimlocation1(2) = 0

Set dimd = ThisDrawing.ModelSpace.AddDimAligned(dimdpoint1, dimdpoint2, dimlocation1) dimd.ArrowheadSize = 5 dimd.textheight = 5

If UserForm8.OptionButton2.Value = True Then d1 = d2 dimdpoint1(0) = zstp(0): dimdpoint1(1) = zstp(1) + d1 / 2: dimdpoint1(2) = 0 dimdpoint2(0) = zstp(0): dimdpoint2(1) = zstp(1) - d1 / 2: dimdpoint2(2) = 0 dimlocation1(0) = zstp(0) - 20: dimlocation1(1) = zstp(1): dimlocation1(2) = 0

Set dimd = ThisDrawing.ModelSpace.AddDimAligned(dimdpoint1, dimdpoint2, dimlocation1) dimd.ArrowheadSize = 5 dimd.textheight = 5

dimdpoint1(0) = zstp(0): dimdpoint1(1) = zstp(1) - da / 2: dimdpoint1(2) = 0

40


齐贤伟 基于AUTOCAD VBA渐开线斜齿轮参数化设计系统(9).doc 将本文的Word文档下载到电脑 下载失败或者文档不完整,请联系客服人员解决!

下一篇:`SQL Server 2008R2数据库备份与还原操作文档

相关阅读
本类排行
× 注册会员免费下载(下载后可以自由复制和排版)

马上注册会员

注:下载文档有可能“只有目录或者内容不全”等情况,请下载之前注意辨别,如果您已付费且无法下载或内容有问题,请联系我们协助你处理。
微信: QQ: