[求助]下面的程序总是提示有错

chman

如图所示，处理四边形没有问题，如果处理的是如图所示的六边形，总是提示出错了 Sub tt()
Dim pnt
Dim picked As Boolean
Dim px() As Double
Dim py() As Double
Dim i, k, j As Integer
Dim pcenter() As Double
Dim insertdistance() As Double
Do While 1
pnt = ThisDrawing.Utility.GetPoint(, "在闭合圈内点击")
ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & pnt(0) & "," & pnt(1) & vbCr & vbCr
Set pr = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
Dim retCoord As Variant
retCoord = pr.Coordinates
k = (UBound(retCoord) + 1) / 2
ReDim px(UBound(retCoord)) As Double
ReDim py(UBound(retCoord)) As Double
For i = 0 To UBound(retCoord) Step 2
px(i / 2) = retCoord(i)
py(i / 2) = retCoord(i + 1)
Next i

ReDim pcenter(k - 2) As Double
ReDim insertdistance(k - 2) As Double
For i = 0 To k - 2
pcenter(0) = (px(i) + px(i + 1)) / 2
pcenter(1) = (py(i) + py(i + 1)) / 2
insertdistance(i) = Sqr((px(i) - px(i + 1)) * (px(i) - px(i + 1)) + (py(i) - py(i + 1)) * (py(i) - py(i + 1)))
insertdistance(i) = Format(insertdistance(i), "#,##0.00;;;Nil")
ThisDrawing.ModelSpace.AddText insertdistance(i), pcenter, 0.65
Next i

picked = True

Loop

End Sub

yulijin608

问题在于ReDim pcenter(k - 2) As Double


当是6边行时,ThisDrawing.ModelSpace.AddText insertdistance(i), pcenter, 0.65


中 pcenter含5个数,而坐标为3个double数元

chman

我个人认为：如果定义为


ReDim pcenter(1) As Double


那就没有问题了


i 增加一个值，都对pcenter（0），pcenter（1）重新赋值。


但事实上程序仍然出错的。


能帮我想个办法，解决这个问题，，要能同时解决上述两种图形的情况。谢啦

yulijin608

下面的程序在AutoCAD MAP 2000上通过 Sub tt()
On Error GoTo Err_Control
Dim pnt
Dim picked As Boolean
Dim px() As Double
Dim py() As Double
Dim i, k, j As Integer
Dim pcenter() As Double
Dim insertdistance() As Double
Do While 1
pnt = ThisDrawing.Utility.GetPoint(, "在闭合圈内点击")
ThisDrawing.SendCommand "-boundary" & vbCr & "a" & vbCr & "b" & vbCr & "e" & vbCr & vbCr & pnt(0) & "," & pnt(1) & vbCr & vbCr
Set pr = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
Dim retCoord As Variant
retCoord = pr.Coordinates
k = (UBound(retCoord) + 1) / 2
ReDim px(UBound(retCoord)) As Double
ReDim py(UBound(retCoord)) As Double
For i = 0 To UBound(retCoord) Step 2
px(i / 2) = retCoord(i)
py(i / 2) = retCoord(i + 1)
Next i

ReDim pcenter(0 To 2) As Double
ReDim insertdistance(k - 2) As Double
For i = 0 To k - 2
pcenter(0) = (px(i) + px(i + 1)) / 2
pcenter(1) = (py(i) + py(i + 1)) / 2
pcenter(2) = 0
insertdistance(i) = Sqr((px(i) - px(i + 1)) * (px(i) - px(i + 1)) + (py(i) - py(i + 1)) * (py(i) - py(i + 1)))
insertdistance(i) = Format(insertdistance(i), "#,##0.00;;;Nil")
ThisDrawing.ModelSpace.AddText insertdistance(i), pcenter, 0.65
Next i

picked = True

Loop
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case -2147467259
'右键单击或回车或空格
Err.Clear
Resume Exit_Here
End Select

End Sub

tiger8888

楼上的两位版主给我很大启发

chman

yulijin608非常感谢 我看到上面得到的px，py明显是个二维点，所以下面就将插入点也当成是二维的处理了。 奇怪的是pcenter是三维的。二维的居然不通过，很是纳闷啊。 不过问题是解决了。 谢谢