请各位大高手大哥帮我看下这个程序,解决下问题谢谢

jy309001 · 发表于 2005-6-1 00:04:00

我是初学者,请教哪位大虾可以把它改一下，因为我这个程序只有画５边形才能放，有没有可以弄个循环语句然后随便画几边形都可以进行缩放.
Sub Line2()
Dim VarRet As Variant
Dim NewLine1 As Object
Dim NewLine2 As Object
Dim NewLine3 As Object
Dim PT1(0 To 2) As Double
Dim PT2(0 To 2) As Double
Dim PT3(0 To 2) As Double
Dim PT4(0 To 2) As Double
Dim PT5(0 To 2) As Double
Dim points(0 To 9) As Double
Dim plineObj As AcadLWPolyline
Dim i As Variant
Dim j As Variant
Dim s As Variant
Dim t As Variant
Dim k As Variant
Dim m As Variant
Dim n As Variant
k = ThisDrawing.Utility.GetInteger("请输入边数:")
i = ThisDrawing.Utility.GetInteger("请输入向内放样个数:")
s = ThisDrawing.Utility.GetInteger("请输入向外放样个数:")
VarRet = Utility.GetPoint(, "Point1: ")
PT1(0) = VarRet(0)
PT1(1) = VarRet(1)
VarRet = Utility.GetPoint(PT1, "Point2: ")
PT2(0) = VarRet(0)
PT2(1) = VarRet(1)
VarRet = Utility.GetPoint(PT1, "Point3: ")
PT3(0) = VarRet(0)
PT3(1) = VarRet(1)
VarRet = Utility.GetPoint(PT1, "Point4: ")
PT4(0) = VarRet(0)
PT4(1) = VarRet(1)
VarRet = Utility.GetPoint(PT1, "Point5: ")
PT5(0) = VarRet(0)
PT5(1) = VarRet(1)
points(0) = PT1(0)
points(1) = PT1(1)
points(2) = PT2(0)
points(3) = PT2(1)
points(4) = PT3(0)
points(5) = PT3(1)
points(6) = PT4(0)
points(7) = PT4(1)
points(8) = PT5(0)
points(9) = PT5(1)
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
plineObj.Closed = True
Set PlineCopy = plineObj.Copy
PlineCopy.color = acRed
ZoomAll
Do
m = ThisDrawing.Utility.GetInteger("请输入向内偏移量:")
If m = 0 Then
MsgBox "请输入负值"
Else
Exit Do
End If
Loop
Dim offsetObj As Variant
For j = 1 To i
offsetObj = plineObj.Offset(m * j)
Next j
ZoomAll
For t = 1 To s
offsetObj = plineObj.Offset(n * t)
Next t
ZoomAll
End Sub

wyj7485 · 发表于 2005-6-1 16:06:00

'可以输入任意边数:Sub Line2()Dim VarRet As Variant
Dim NewLine1 As Object
Dim NewLine2 As Object
Dim NewLine3 As Object
Dim PT1(0 To 2) As Double
Dim PT2(0 To 2) As Double
Dim PT3(0 To 2) As Double
Dim PT4(0 To 2) As Double
Dim PT5(0 To 2) As DoubleDim points(0 To 9) As Double
Dim plineObj As AcadLWPolyline
Dim i As Variant
Dim j As Variant
Dim s As Variant
Dim t As Variant

copy


Dim k As Integer

Dim m As Variant
Dim n As Variant

copy


Dim a
Dim Var As Variant
k = ThisDrawing.Utility.GetInteger("请输入边数:")
ReDim Var(2 * k - 1) As Double
  
i = ThisDrawing.Utility.GetInteger("请输入向内放样个数:")
s = ThisDrawing.Utility.GetInteger("请输入向外放样个数:")
For a = 0 To k - 1
VarRet = Utility.GetPoint(, "Point" & Str(a) & ": ")
Var(2 * a) = VarRet(0)
Var(2 * a + 1) = VarRet(1)
NextSet plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Var)

plineObj.Closed = True
Set PlineCopy = plineObj.Copy
PlineCopy.color = acRed
ZoomAllDo
m = ThisDrawing.Utility.GetInteger("请输入向内偏移量:")
If m = 0 Then
MsgBox "请输入负值"
Else
Exit Do
End If
LoopDim offsetObj As Variant
For j = 1 To i
offsetObj = plineObj.Offset(m * j)Next j
ZoomAll
For t = 1 To s
offsetObj = plineObj.Offset(n * t)Next t
ZoomAllEnd Sub