'绘制箭头
Sub DrawJianTou()
    On Error Resume Next
    Dim P1 As Variant
    Dim P2 As Variant
    Dim N As Integer
    Dim Plist() As Double
    Dim L() As AcadEntity
    P1 = ThisDrawing.Utility.GetPoint(, "指定点:")
    N = 2
xNext:

    P2 = ThisDrawing.Utility.GetPoint(P1, "指定下一点:")
    ReDim Preserve L(N / 2 - 1)
    Set L(UBound(L)) = ThisDrawing.ModelSpace.AddLine(P1, P2)  '不知道为什么添加的直线的index不是连续。 用thisdrawing.ModelSpace.Item(index) 删除不掉添加的直线，只能把他们添加到一个数值中。
    N = N + 2
    ReDim Preserve Plist(N - 1)
    Plist(N - 4) = P1(0):  Plist(N - 3) = P1(1): Plist(N - 2) = P2(0):  Plist(N - 1) = P2(1)
    
    P1 = P2
   
    If Err Then
        GoTo D
    Else
        GoTo xNext
    End If
D:
    Dim i As Long
    For i = 0 To UBound(L)
       L(i).Delete
    Next i
    
    Dim PL As AcadLWPolyline
    Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(Plist)
    
    PL.SetWidth (UBound(Plist) - 1) / 2 - 2, 200, 0
    
 
End Sub