计算用户输入的点定义的图形面积。要获取用户输入的点指定的面积,可以测量由用户指定的二维或三维点定义的任意闭合面域。这些点必须共面。
- 在一个循环中使用 GetPoint 方法获取用户指定的点。
- 根据用户提供的点创建优化多段线。使用 AddLightweightPolyline 方法创建多段线。
- 使用 Area 特性获取新创建的多段线的面积。
- 使用 Erase 方法删除多段线。
本例提示用户输入五个点,然后根据输入的点创建多段线。该多段线是闭合的,所形成的面积显示在消息框中。
Sub Ch3_CalculateDefinedArea()
Dim p1 As Variant
Dim p2 As Variant
Dim p3 As Variant
Dim p4 As Variant
Dim p5 As Variant
' 获取用户输入的点
p1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "First point: ")
p2 = ThisDrawing.Utility.GetPoint(p1, vbCrLf & "Second point: ")
p3 = ThisDrawing.Utility.GetPoint(p2, vbCrLf & "Third point: ")
p4 = ThisDrawing.Utility.GetPoint(p3, vbCrLf & "Fourth point: ")
p5 = ThisDrawing.Utility.GetPoint(p4, vbCrLf & "Fifth point: ")
' 根据这些点创建二维多段线
Dim polyObj As AcadLWPolyline
Dim vertices(0 To 9) As Double
vertices(0) = p1(0): vertices(1) = p1(1)
vertices(2) = p2(0): vertices(3) = p2(1)
vertices(4) = p3(0): vertices(5) = p3(1)
vertices(6) = p4(0): vertices(7) = p4(1)
vertices(8) = p5(0): vertices(9) = p5(1)
Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline _
(vertices)
polyObj.Closed = True
ThisDrawing.Application.ZoomAll
' 显示多段线的面积
MsgBox "The area defined by the points is " & _
polyObj.Area, , "Calculate Defined Area"
End Sub