Public Sub createpolylinebasic()
'动态创建多段线
On Error Resume Next
Dim index As Integer '当前输入点的次数
index = 2
'提示用户输入第一点
Dim pt1 As Variant
pt1 = ThisDrawing.Utility.GetPoint(, "输入第一点:")
If Err Then '处理EXc键或者ENTER键的事件
Err.Clear
Exit Sub
End If
Dim ptprevious As Variant '拾取点过程中,存储上一点和当前点的变量
Dim ptcurrent As Variant
ptprevious = pt1
nextpoint:
ptcurrent = ThisDrawing.Utility.GetPoint(ptprevious, "输入下一点:")
If Err Then '处理EXc键或者ENTER键的事件
Err.Clear
Exit Sub
End If
Dim objpline As AcadLWPolyline
If index = 2 Then
'创建多段线
Dim points(0 To 3) As Double
points(0) = ptprevious(0)
points(1) = ptprevious(1)
points(2) = ptcurrent(0)
points(3) = ptcurrent(1)
Set objpiine = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)