Sub Match_Properties_Polyline()
'-------------------------------

On Error Resume Next
Dim varPick As Variant
Dim SourceArea As Double
Dim SourceLayer As AcadLayer
Dim SourceLayerStr As String
Dim SS1 As AcadSelectionSet
Dim SS2 As AcadSelectionSet

'------------------------------------
Set SS1 = ThisDrawing.SelectionSets("Source")
If Err <> 0 Then
        Err.Clear
        Set SS1 = ThisDrawing.SelectionSets.Add("Source")
    Else
        SS1.Clear
    End If
    
varPick = ThisDrawing.Utility.GetPoint(, vbCrLf & "Select source Polyline: ")
SS1.SelectAtPoint varPick

Dim SourceObj As AcadLWPolyline
For Each SourceObj In SS1
    SourceLayer = SourceObj.Layer
    SourceArea = SourceObj.Area
Next SourceObj
SS1.Delete

'-------------------------------------------------
Set SS2 = ThisDrawing.SelectionSets("Destination")
If Err <> 0 Then
        Err.Clear
        Set SS2 = ThisDrawing.SelectionSets.Add("Destination")
    Else
        SS2.Clear
    End If
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 0: FilterData(0) = "LWPolyline"
SS2.SelectOnScreen FilterType, FilterData

Dim DesObj As AcadLWPolyline
For Each DesObj In SS2
    If DesObj.Area = SourceArea Then
        DesObj.Layer = SourceLayer
        DesObj.Update
    End If
Next DesObj
SS2.Delete
    
End Sub