|
|
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)
ElseIf index > 2 Then
Dim ptvert(0 To 1) As Double
ptvert(0) = ptcurrent(0)
ptvert(1) = ptcurrent(1)
objpline.AddVertex index - 1, ptvert
End If
index = index + 1
ptprevious = ptcurrent
GoTo nextpoint
End Sub
以上代码只能创建一段，想连续创建要怎么改 |
|
置顶卡
