Selecting an entity and getting its layer and setting that in a listbox

I have a listbox with all the layers in a drawing (lstLayers)

I have this handler for a button:

Private Sub cmdLayerFromEntity_Click()

On Error Resume Next

Dim objEntity As AcadObject
Dim ptPicked As Variant

Me.Hide
ThisDrawing.Utility.GetEntity objEntity, ptPicked, _
"Select a entity to extract the layer name from:"
If Err.Number = 0 Then
lstLayers.Text = objEntity.Layer
End If
Me.Show

End Sub


But it don't work well. For one thing, i can't work out how to select the right index based on the layer name of the entity.

 

The listbox seems to be accepting the click event that you select the object. I tried it and found that disabling the listbox before you hide the form and enabling it when you show it solves the problem.

Code:

Option Explicit

Private Sub UserForm_Initialize()
Dim objLayer As AcadLayer
For Each objLayer In ThisDrawing.Layers
lstLayers.AddItem objLayer.Name
Next objLayer
End Sub

Private Sub cmdLayerFromEntity_Click()

On Error Resume Next

Dim objEntity As AcadObject
Dim ptPicked As Variant

lstLayers.Enabled = False
Me.Hide
ThisDrawing.Utility.GetEntity objEntity, ptPicked, _
"Select a entity to extract the layer name from:"
If Err.Number = 0 Then
lstLayers.Text = objEntity.Layer
End If
Me.Show
lstLayers.Enabled = True

End Sub

 

I will give this a try. Thank you.

 

This works fine like you said. So I was on the right tracks by just setting the text value and it would find it in the listbox. It was the click fooling it.

 

Is it possible to somehow loop the selection of the entity so that when they click on it, it gets highlighted. if it is not the one they want, they click another for it to select that one. eventually, you have the right entity highlighted so you press return, right-mouse button etc.

Thoughts?

 

One question...

If I press the ESC key, it returns to the dialogue and the listbox remains disabled.

This is my latest handler:

Private Sub cmdLayerFromEntity_Click()

On Error Resume Next

Dim objEntity As AcadObject
Dim ptPicked As Variant

lstLayers.Enabled = False
Me.Hide

SelectEntity:
ThisDrawing.Utility.GetEntity objEntity, ptPicked, _
vbCrLf & "Select a entity to extract the layer name from:"
If Err.Number = 0 Then
lstLayers.Text = objEntity.Layer
If TypeOf objEntity Is AcadPoint Then
cbAnnoEntityType.ListIndex = shAnnoEntityPoints
ElseIf TypeOf objEntity Is Acad3DPolyline Then
cbAnnoEntityType.ListIndex = shAnnoEntityPolylines
Else
UpdateUserPrompt (" You must select a POINT or 3D POLYLINE.")
GoTo SelectEntity
End If
End If
Me.Show
lstLayers.Enabled = True

End Sub