Change some objects from one layer to onother - VBA

[zimGirl]

I have over 16000 object on the application and I want to select only the blue ones (200) and them meove them to a different layer. I tried the selection set, but could not get the blue ones selected and changed.
I know this can be done in properties where yuo can filter by color, but I want to do it programmatically as it involves several drawings. I want to create a macro that will do this. Can someboby help me?

 

[PLB]

Hi zimGirl,

I have written a few LISP programs that will create a selection set of objects from a specific layer and with a specific color... Something like this:

(setq zimgirl (ssget "x" '((8 . "LAYER") (62 . 200))))
(if (/= zimgirl nil)
(command "change" zimgirl "" "P" "LA" "LAYER" "C" "BYLAYER" ""))

Please note that you will want to change a couple of places here. The first one is the word LAYER in: (8 . "LAYER"). You will want to change LAYER to the name of the actual layer in your application where all of these items currently reside. The second change is the "LAYER" in the last line of code. Here you want to use the name of the layer that you want all the selection set items to go to. Remember to use the double quotes (") on both sides of the layer name.

Hope this helps,
Paul

 

[zimGirl]

Thanks.
I should have been more specific as to Programming language. I needed a VBA Code, but this helped a bit with understanding what needed to be done. My final code for this was:

'declarations
Dim objRiver As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim riverLayer As AcadLayer

Sub LayerChangeSelection()
    On Error GoTo Done
''make layer and give it color
    Set riverLayer = ThisDrawing.Layers.Add("Rivers")
    riverLayer.Color = acBlue
    
  ' Create the new selection set  
    Set objRiver = ThisDrawing.SelectionSets.Add("River")
  'create the filter for the selection set
    FilterType(0) = 62
    FilterData(0) = acBlue
    ''make the selection of the specific objects
objRiver.Select acSelectionSetAll, , , FilterType, FilterData
''Move them to created layerslayers
 Dim objRiverEnt As AcadEntity
For Each objRiverEnt In objRiver
    objRiverEnt.Layer = "Rivers" ' desired layer 
    objRiverEnt.Update
Next

Done:
''if selection exists, delete it
If  Not objRiver Is Nothing Then
    objRiver.Delete
End If

End Sub