'*********************************************************************************************
'绘制窗线*************************************************绘制窗线******************************
'
Sub ChuangXian()
    On Error Resume Next
    Dim W As Long
    W = ThisDrawing.Utility.GetDistance(, "输入窗棂的宽度(240):")
    '错误检查
    If Err.Number = -2147352567 Then                                    '用户按下Esc键,则退出.
        Err.Clear
        Exit Sub
    ElseIf Err Then                                                     '如果用户按下 enter 按钮或者输入有误,使用默认值
        W = 240
        Err.Clear
    End If
    Dim P1 As Variant
    Dim P2 As Variant
    Dim PList() As Double
    Dim N As Long
    Dim Elist() As AcadEntity
    ReDim Preserve Elist(0)
    
    P1 = ThisDrawing.Utility.GetPoint(, "指定点:")
xNext:

    P2 = ThisDrawing.Utility.GetPoint(P1, "指定下一点:")
     
    N = N + 2
    ReDim Preserve PList(N * 2 - 1)
    PList(N * 2 - 4) = P1(0):    PList(N * 2 - 3) = P1(1):   PList(N * 2 - 2) = P2(0):    PList(N * 2 - 1) = P2(1):
    
    Dim L0 As AcadLine
    Dim L As AcadLine
    Dim A As Double
    Set L0 = ThisDrawing.ModelSpace.AddLine(P1, P2)
    '将L0添加到Elist数组中，以便于删除
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L0
    
    A = L0.angle
    L0.color = acRed
    Dim Ps As Variant
    Dim Pe As Variant
    Ps = GetPointAR(P1, A + Atn(1) * 2, W / 2)
    Pe = GetPointAR(P2, A + Atn(1) * 2, W / 2)
    Set L = ThisDrawing.ModelSpace.AddLine(Ps, Pe)
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L
    
    Ps = GetPointAR(P1, A + Atn(1) * 2, W / 6)
    Pe = GetPointAR(P2, A + Atn(1) * 2, W / 6)
    Set L = ThisDrawing.ModelSpace.AddLine(Ps, Pe)
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L
    
    Ps = GetPointAR(P1, A - Atn(1) * 2, W / 2)
    Pe = GetPointAR(P2, A - Atn(1) * 2, W / 2)
    Set L = ThisDrawing.ModelSpace.AddLine(Ps, Pe)
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L
    
    Ps = GetPointAR(P1, A - Atn(1) * 2, W / 6)
    Pe = GetPointAR(P2, A - Atn(1) * 2, W / 6)
    Set L = ThisDrawing.ModelSpace.AddLine(Ps, Pe)
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L
    
    P1 = P2
    If Err Then
        GoTo D
    Else
        GoTo xNext
    End If
D:
    '删除无用的线段
    Dim i  As Long
    Prompt Str(UBound(Elist))
    For i = 0 To UBound(Elist)
        Elist(i).Delete
    Next i
    '从新绘制墙线 (多段线)
    Dim PL As AcadLWPolyline
    Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(PList)
    PL.offset W / 2
    PL.offset W / 6
    PL.offset -W / 2
    PL.offset -W / 6
    PL.Delete
End Sub
'**********************************************************************************************

'*********************************************************************************************
'绘制墙线*************************************************绘制墙线******************************
'
Sub QiangXian()
    On Error Resume Next
    Dim W As Long
    W = ThisDrawing.Utility.GetDistance(, "输入墙的宽度(240):")
    '错误检查
    If Err.Number = -2147352567 Then                                    '用户按下Esc键,则退出.
        Err.Clear
        Exit Sub
    ElseIf Err Then                                                     '如果用户按下 enter 按钮或者输入有误,使用默认值
        W = 240
        Err.Clear
    End If
    Dim P1 As Variant
    Dim P2 As Variant
    Dim PList() As Double
    Dim N As Long
    Dim Elist() As AcadEntity
    ReDim Preserve Elist(0)
    P1 = ThisDrawing.Utility.GetPoint(, "指定点:")
xNext:

    P2 = ThisDrawing.Utility.GetPoint(P1, "指定下一点:")
    '记录顶点二维坐标
    N = N + 2
    ReDim Preserve PList(N * 2 - 1)
    PList(N * 2 - 4) = P1(0):    PList(N * 2 - 3) = P1(1):   PList(N * 2 - 2) = P2(0):    PList(N * 2 - 1) = P2(1):
    '绘制中心线(预览用)
    Dim L0 As AcadLine
    Dim L As AcadLine
    Dim A As Double
    Set L0 = ThisDrawing.ModelSpace.AddLine(P1, P2)
    '将L0添加到Elist数组中，以便于删除
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L0
    '绘制墙线(预览用)
    A = L0.angle
    L0.color = acRed
    Dim Ps As Variant
    Dim Pe As Variant
    Ps = GetPointAR(P1, A + Atn(1) * 2, W / 2) '计算相对已知点一定角度和距离的点
    Pe = GetPointAR(P2, A + Atn(1) * 2, W / 2)
    Set L = ThisDrawing.ModelSpace.AddLine(Ps, Pe)
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L
    
    Ps = GetPointAR(P1, A - Atn(1) * 2, W / 2)
    Pe = GetPointAR(P2, A - Atn(1) * 2, W / 2)
    Set L = ThisDrawing.ModelSpace.AddLine(Ps, Pe)
    ReDim Preserve Elist(UBound(Elist) + 1)
    Set Elist(UBound(Elist)) = L
    
    '循环，P2点将是下一段的起点
    P1 = P2
    If Err Then
        GoTo D
    Else
        GoTo xNext
    End If
D:
    '删除无用的线段
    Dim i  As Long
    Prompt Str(UBound(Elist))
    For i = 0 To UBound(Elist)
        Elist(i).Delete
    Next i
    '从新绘制墙线 (多段线)
    Dim PL As AcadLWPolyline
    Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(PList)
    PL.offset W / 2 '偏移一半墙厚
    PL.offset -W / 2
    PL.Delete
End Sub
'*********************************************************************************************