|
这是一个螺栓标准件的自动作图程序,程序现在已经能运行了 ,可是问题挺多的 ,所以恳请高手帮忙运行下,提点宝贵意见~~~谢谢!现 程序如下:
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 Subx = 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 |
|