计算多段线的长度，代码如下。
Sub PolyLineLength()
Dim Pnt As Variant
Dim Ent As AcadEntity
On Error Resume Next
Do
ThisDrawing.Utility.GetEntity Ent, Pnt, "选择多段线："
If Err Then Exit Sub
If TypeName(Ent) Like "IAcad*Polyline" Then Exit Do
Loop
Dim CoordinateCount As Long
If TypeName(Ent) = "IAcadLWPolyline" Then
CoordinateCount = (UBound(Ent.Coordinates) + 1) / 2
ElseIf (TypeName(Ent) = "IAcadPolyline" And Ent.Type = acSimplePoly) Or (TypeName(Ent) = "IAcad3DPolyline" And Ent.Type = acSimple3DPoly) Then
CoordinateCount = (UBound(Ent.Coordinates) + 1) / 3
Else
Exit Sub
End If
Dim i As Long
Dim TotalLength As Double
Dim Bugle As Double
If TypeName(Ent) = "IAcad3DPolyline" Then
For i = 0 To CoordinateCount - 2
TotalLength = TotalLength + GetArcLeng(Ent.Coordinate(i), Ent, Coordinate(i + 1), 0)
Next
If Ent.Closed Then TotalLength = TotalLength + GetArcLeng(Ent.Coordinate(CoordinateCount - 1), Ent.Coordinate(0), 0)
Else
For i = 0 To CoordinateCount - 2
TotalLength = TotalLength + GetArcLeng(Ent.Coordinate(i), Ent.Coordinate(i + 1), Ent.GetBulge(i))
Next
If Ent.Closed Then TotalLength = TotalLength + GetArcLeng(Ent.Coordinate(CoordinateCount - 1), Ent.Coordinate(0), Ent.GetBulge(CoordinateCount - 1))
End If
MsgBox "选定多段线的总长度为：" & TotalLength
End Sub
Private Function GetArcLeng(PointS As Variant, PointE As Variant, Bugle As Double) As Double
Dim Angle As Double
Dim Radius As Double
Dim Length As Double
Dim Dist As Double
Dim i As Integer
For i = LBound(PointS) To UBound(PointS)
Dist = Dist + ((PointS(i) - PointE(i)) ^ 2)
Next
Length = Sqr(Dist)
If Bugle = 0 Then
GetArcLeng = Length
Else
Angle = 4 * Atn(Abs(Bugle))
Radius = (Length / 2) / Sin(Angle / 2)
GetArcLeng = Radius * Angle
End If
End Function
代码完。