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

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

我是初学者,请教哪位大虾可以把它改一下,因为我这个程序只有画5边形才能放,有没有可以弄个循环语句然后随便画几边形都可以进行缩放.<BR>Sub Line2()


Dim VarRet As Variant<BR>Dim NewLine1 As Object<BR>Dim NewLine2 As Object<BR>Dim NewLine3 As Object<BR>Dim PT1(0 To 2) As Double<BR>Dim PT2(0 To 2) As Double<BR>Dim PT3(0 To 2) As Double<BR>Dim PT4(0 To 2) As Double<BR>Dim PT5(0 To 2) As Double


Dim points(0 To 9) As Double<BR>Dim plineObj As AcadLWPolyline<BR>Dim i As Variant<BR>Dim j As Variant<BR>Dim s As Variant<BR>Dim t As Variant<BR>Dim k As Variant<BR>Dim m As Variant<BR>Dim n As Variant


<BR>k = ThisDrawing.Utility.GetInteger("请输入边数:")<BR>i = ThisDrawing.Utility.GetInteger("请输入向内放样个数:")<BR>s = ThisDrawing.Utility.GetInteger("请输入向外放样个数:")<BR>VarRet = Utility.GetPoint(, "Point1: ")<BR>PT1(0) = VarRet(0)<BR>PT1(1) = VarRet(1)


VarRet = Utility.GetPoint(PT1, "Point2: ")<BR>PT2(0) = VarRet(0)<BR>PT2(1) = VarRet(1)


VarRet = Utility.GetPoint(PT1, "Point3: ")<BR>PT3(0) = VarRet(0)<BR>PT3(1) = VarRet(1)


VarRet = Utility.GetPoint(PT1, "Point4: ")<BR>PT4(0) = VarRet(0)<BR>PT4(1) = VarRet(1)


VarRet = Utility.GetPoint(PT1, "Point5: ")<BR>PT5(0) = VarRet(0)<BR>PT5(1) = VarRet(1)


points(0) = PT1(0)<BR>points(1) = PT1(1)<BR>points(2) = PT2(0)<BR>points(3) = PT2(1)<BR>points(4) = PT3(0)<BR>points(5) = PT3(1)<BR>points(6) = PT4(0)<BR>points(7) = PT4(1)<BR>points(8) = PT5(0)<BR>points(9) = PT5(1)


Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)<BR>plineObj.Closed = True<BR>Set PlineCopy = plineObj.Copy<BR>PlineCopy.color = acRed<BR>ZoomAll


Do<BR>m = ThisDrawing.Utility.GetInteger("请输入向内偏移量:")<BR>If m &lt;= 0 Then<BR>MsgBox "请输入正值"<BR>Else<BR>Exit Do<BR>End If<BR>Loop


Do<BR>n = ThisDrawing.Utility.GetInteger("请输入向外偏移量(-):")<BR>If n &gt;= 0 Then<BR>MsgBox "请输入负值"<BR>Else<BR>Exit Do<BR>End If<BR>Loop


Dim offsetObj As Variant<BR>For j = 1 To i<BR>offsetObj = plineObj.Offset(m * j)


Next j<BR>ZoomAll<BR>For t = 1 To s<BR>offsetObj = plineObj.Offset(n * t)


Next t<BR>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 VariantDim k As IntegerDim m As Variant
Dim n As VariantDim 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
LoopDo
n = ThisDrawing.Utility.GetInteger("请输入向外偏移量(-):")
If n >= 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

lichenxui 发表于 2011-12-10 23:37:27

收下,谢谢分享

lichenxui 发表于 2011-12-10 23:39:44

很多都看不懂啊
页: [1]
查看完整版本: 请各位大高手大哥帮我看下这个程序,解决下问题 谢谢