Change some objects from one layer to onother - VBA
Change some objects from one layer to onother - VBA
(OP)
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?
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?






RE: Change some objects from one layer to onother - VBA
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
RE: Change some objects from one layer to onother - VBA
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:
CODE
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