右侧代码窗口中拷贝如下代码:
Sub Test()
On Error Resume Next
ActiveDocument.Unit = cdrMillimeter
Dim sl As Shape, xSel As ShapeRange, m As Double, n As Double
Set xSel = ActiveSelectionRange
If ActiveSelectionRange.Count > 1 Or ActiveSelectionRange.Count = 0 Then
MsgBox "请先选中1条曲线。"
Exit Sub
End If
m = xSel.Shapes(1).Curve.Length
n = xSel.Shapes(1).Curve.Area
MsgBox "曲线长度L(mm):" & Format(m, "0.0000") & Chr(13) & "曲线面积S(mm2):" & Format(n, "0.0000")
End Sub