Highlight drawed entities by layer name

[Anonymous]

I have a drawing with two drawingentities.

a circle drawed in the layer named "layer01" and

a line drawed in the layer named "layer02"

Now I want a vba code that select (highlight) all drawed entities in layer01 and layer02.

That's all

Is that possible in VBA?

gr. Laszlo

[Alfred.NESWADBA]

Hi,

Public Sub HighlightTest()
   Dim tSelSet As AcadSelectionSet
   Set tSelSet = getSelSetByLayer("Layer01")
   If tSelSet Is Nothing Then
      MsgBox ("No Selectionset")
   ElseIf tSelSet.Count = 0 Then
      MsgBox ("No objects found on Layer 'Layer01'")
   Else
      Dim tEnt As AcadEntity
      For Each tEnt In tSelSet
         tEnt.Highlight (True)
      Next
   End If
End Sub

Private Function getSelSetByLayer(ByVal LayerName As String) As AcadSelectionSet
   Dim tRetVal As AcadSelectionSet
   On Error Resume Next
   'create selectionset
   Set tRetVal = ThisDrawing.SelectionSets.Add("mySelSet")
   If tRetVal Is Nothing Then Set tRetVal = ThisDrawing.SelectionSets.Item("mySelSet")
   'create filter for selection
   Dim tDxfCodes(0) As Integer: tDxfCodes(0) = 8     '8=dxfcode for "layername"
   Dim tDxfValues(0) As Variant: tDxfValues(0) = LayerName
   'select
   tRetVal.Clear
   Call tRetVal.Select(acSelectionSetAll, , , tDxfCodes, tDxfValues)
   'return
   Set getSelSetByLayer = tRetVal
End Function

HTH, - alfred -

[Anonymous]

Thank you Alfred, but it only works with layer01 not with layer02.

I tried: Set tSelSet = getSelSetByLayer("Layer01", "layer02") but it returned with an error:

"Wrong number of arguments or invalid property assignement."

I forgot something?

gr. László

[Alfred.NESWADBA]

Hi,

you can define the layername-filter in one of the following modes:

• using a comma as separator to define multiple distinct layernames (be careful, don't write a space after the comma)
• using wildchars like "?" or "*"

HTH, - alfred -

Samples:

Set tSelSet = getSelSetByLayer("Layer01,Layer02")
Set tSelSet = getSelSetByLayer("Layer0?")
Set tSelSet = getSelSetByLayer("Layer??")
Set tSelSet = getSelSetByLayer("Layer*")

[Anonymous]

Thank you again Alfred!

It works great.

I learned a lot from it.

gr. Laszlo

[Anonymous]

This code works fine.

Now I wants a different layer zb. layer03 to be highlight (false). How to combine this in the same code?

gr. Laszlo

Public Sub HighlightTest()
   Dim tSelSet As AcadSelectionSet
   Set tSelSet = getSelSetByLayer("Layer01")
   If tSelSet Is Nothing Then
      MsgBox ("No Selectionset")
   ElseIf tSelSet.Count = 0 Then
      MsgBox ("No objects found on Layer 'Layer01'")
   Else
      Dim tEnt As AcadEntity
      For Each tEnt In tSelSet
         tEnt.Highlight (True)
      Next
   End If
End Sub

Private Function getSelSetByLayer(ByVal LayerName As String) As AcadSelectionSet
   Dim tRetVal As AcadSelectionSet
   On Error Resume Next
   'create selectionset
   Set tRetVal = ThisDrawing.SelectionSets.Add("mySelSet")
   If tRetVal Is Nothing Then Set tRetVal = ThisDrawing.SelectionSets.Item("mySelSet")
   'create filter for selection
   Dim tDxfCodes(0) As Integer: tDxfCodes(0) = 8     '8=dxfcode for "layername"
   Dim tDxfValues(0) As Variant: tDxfValues(0) = LayerName
   'select
   tRetVal.Clear
   Call tRetVal.Select(acSelectionSetAll, , , tDxfCodes, tDxfValues)
   'return
   Set getSelSetByLayer = tRetVal
End Function

[Alfred.NESWADBA]

Hi,

Public Sub HighlightTest()
   Dim tSelSet As AcadSelectionSet
   Set tSelSet = getSelSetByLayer("Layer01,Layer02,Layer03")
   If tSelSet Is Nothing Then
      MsgBox ("No Selectionset")
   ElseIf tSelSet.Count = 0 Then
      MsgBox ("No objects found on Layer 'Layer01/02/02'")
   Else
      Dim tEnt As AcadEntity
      For Each tEnt In tSelSet
         Select case ucase(tEnt.Layer)
            case "LAYER01","LAYER02"
               tEnt.Highlight (True)
            case "LAYER03"
               tEnt.Highlight (false)
         End Select
      Next
   End If
End Sub

- alfred -

[Anonymous · Accepted solution]

It's simplier than I thought.

Thanks!

gr. Laszlo