提示输入点创建一条轻多段线

yjr111

rem 模拟cad的pline命令
Option Explicit
Public ms As AcadModelSpace, utiobj As Object
'提示输入点创建一条轻多段线
Private Sub AddLWPline()
    Dim p1 As Variant, ptCurrent As Variant, ptPrevious As Variant
    Dim points(3) As Double, objPline As AcadLWPolyline
    Set utiobj = ThisDrawing.Utility
    Set ms = ThisDrawing.ModelSpace

    On Error Resume Next
    p1 = utiobj.GetPoint(, "输入第一点:")
    If Err.Number = -2145320928 Then
        Err.Clear
        Exit Sub
    End If
    ptPrevious = p1
    While true
        On Error Resume Next
        ptCurrent = utiobj.GetPoint(ptPrevious, "输入下一点:")
        If Err.Number = -2145320928 Then
            Err.Clear
            Exit Sub
        End If
        points(0) = ptPrevious(0)
        points(1) = ptPrevious(1)
        points(2) = ptCurrent(0)
        points(3) = ptCurrent(1)
        Set objPline = ms.AddLightWeightPolyline(points)
        ptPrevious = ptCurrent
    Wend
End Sub

mycad

最好把每一段轻量多一线连成一条整线