[VBA]恳请高手帮忙运行指点下程序

zhdx 发表于 2005-6-5 12:22:00

这是一个螺栓标准件的自动作图程序，程序现在已经能运行了，可是问题挺多的，所以恳请高手帮忙运行下，提点宝贵意见~~~谢谢！现程序如下：

main (thisdrawing)

Public Sub m(d, k, e, s, r, f, b, c, dw) Dim sysOSMODE As Integer sysOSMODE = thisdrawing.GetVariable("OSMODE") thisdrawing.SetVariable "OSMODE", 0 thisdrawing.Utility.InitializeUserInput 32 On Error Resume Next mp = thisdrawing.Utility.GetPoint np = thisdrawing.Utility.GetPoint l = thisdrawing.Utility.GetDistance rotsita = thisdrawing.Utility.GetAngle If s >= l Then s = l - 2# * f End If

thisdrawing.sentcommand ("_polygon" & vbCr & "6" & vbCr & mpstr & vbCr & "c" & vbCr & crad & vbCr) dx = np(0) dx1 = dx0 - k dx2 = ((e / 2# - s / 2#) / 1.732 + dxo) - k dx3 = (1.5 - 1.141) * d + dx0 - k dx5 = dx0 + r + c dx6 = dx0 - b + l - d / 5# + c dx7 = dx0 + l - b + c dx8 = dx0 + l - f + c dx9 = dx0 + l + c dx10 = (dx1 + dx2) / 2# dx11 = dx8 + d / 10# dy0 = np(l) dy2 = dy0 + d / 2# dy3 = dy0 + e * 3 / 8 dy4 = dy0 + s / 2# dy5 = dy0 + e / 2# dy6 = dy0 + r + d / 2# dy7 = dy0 + d / 2# - f dy8 = (dy4 + dy5) / 2# dy9 = dy2 - d / 10#

utilobj.CreateTypedArray p10, vbDouble, dx1, dy0, 0 utilobj.CreateTypedArray p32, vbDouble, dx3, dx2, 1

Set la = blockobj.AddLine(p10, p14)

 Set arca = blockobj.AddArc(cetpt, ccrad, angs, ange)

For Each acadent In blockobj acadent.Mirror p10, np Next acadent

utiobj.CreateTypedArray insertpt, vbDouble, np(0), np(1), np(2)

Set blockrefobj = thisdrawing.ModelSpace.InsertBlock(insertpt, mx, 1#, 1#, 1#, 0) thisdrawing.Regen acavtiveviewport

End Sub

x = sp(0) - ep(0) y = sp(1) - ep(0) distance = spr((x * 2) + (y * 2))

Set l3 = thisdrawing.ModelSpace.AddLine(lcenptl, thisdrawing.unility.PolarPoint(lcenpt1, angel1 + 3.1414926536 / 2, 100)) Set l4 = thisdrawing.ModelSpace.AddLine(lcenpt2, thisdrawing.Utility.PolarPoint(lcenpt2, angel2 + 3.1415926536 / 2, 100)) centerpt = l4.IntersectWith(l3, acExtendBoth)

Public Sub m3() Call m(3#, 2#, 6.4, 5.3, 0.2, 0.6, 12#, 0.4, 4.6)

End Sub

页: [1]

明经CAD社区's Archiver

[VBA]恳请高手帮忙运行指点下程序