VB layers

[andrew.wade]

How do i copy the contents of layers to other layers in vb ?

[Ed Jobe]

The selectionset obj does not have a copy method. Here is a function I wrote to provide one and a demo on how to use it. All you need to do is filter your ss to get only objects on the desired layer. The Dev Guide and this forum have examples on that.



Sub testCopyMove()
Dim ss As AcadSelectionSet
Dim oEnt As AcadEntity

' Define the points that make up the move vector
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
point1(0) = 0: point1(1) = 0: point1(2) = 0
point2(0) = 2: point2(1) = 0: point2(2) = 0

AddSelectionSet ss, "test"
ss.Clear
ss.SelectOnScreen
CopySS ss
For Each oEnt In ss
oEnt.Move point1, point2
oEnt.Layer = "0"
Next oEnt
End Sub

Public Function CopySS(ss As AcadSelectionSet)
On Error GoTo Err_Control
'Replaces the supplied ss with a copy of the selectionset
'for further processing. There isn't a Copy method that
'directly works with selectionsets because a ss is
'derived from a collection and iterating a collection
'opens the objects for read-only, while the Copy method
'needs to open them read-write. Therefore this function
'handles the intermediate step of working with the ss
'as an array.

Dim ary() As AcadEntity
Dim oEnt As AcadEntity
Dim i As Integer

ReDim ary(ss.Count - 1)
'populate the array
For i = 0 To (ss.Count - 1)
Set ary(i) = ss.Item(i)
Next i
'replace the array with a copy
For i = 0 To UBound(ary)
Set oEnt = ary(i).Copy
Set ary(i) = oEnt
Next i
'replace the contents of the ss with the copies.
ss.Clear
ss.AddItems ary

Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
Case Else
MsgBox Err.Number & ", " & Err.Description, , "CopySS"
Err.Clear
Resume Exit_Here
End Select
End Function