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
Solved! Go to Solution.
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 -
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ó
Hi,
you can define the layername-filter in one of the following modes:
HTH, - alfred -
Samples:
Set tSelSet = getSelSetByLayer("Layer01,Layer02")
Set tSelSet = getSelSetByLayer("Layer0?")
Set tSelSet = getSelSetByLayer("Layer??")
Set tSelSet = getSelSetByLayer("Layer*")
Thank you again Alfred!
It works great.
I learned a lot from it.
gr. Laszlo
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
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 -