VBA - Hiding Dialogs and Other Things.

Recently, I posted an article regarding Hiding Dialogs in DCL. Well in this article, we're going to have a look at hiding dialogs using VBA.
"But that's dead easy!" I can hear you saying.
I agree, it is pretty simple. The difficult part is what you do before and after hiding the dialog.
In the following example, we're going to write a routine that will allow us to select a line, and a line only, from our drawing. Whilst we're going about the business of selecting the line, the dialog will disappear from view. On completion of our selection, the dialog will magically re-appear and will display the layer that the line is on, along with the x, y and x co-ordinates of the start and end points of the aforementioned line.
As an added bonus, if you then change the layer or any of the lines co-ordinates from within the dialog, the line itself will be updated in real time upon your screen. Interested? Then try this out :

For this you will need a UserForm containing 1 Label for the Listbox, 1 ListBox, 3 Buttons, two Frames for the TextBoxes, 6 TextBoxes (3 in each Frame,) and 6 Labels for the TextBoxes. Retain all of their default names and captions.

Option Explicit
'-----------------------------
'declare the public variables
Public theline As Object
Public AllLayers As AcadLayers
'------------------------------

Private Sub UserForm_Initialize()
Dim ctr As Integer
Dim layer As Object

'set up the controls
UserForm1.Caption = "Properties of a Line"
Label1.Caption = "Layer"
CommandButton1.Caption = "Select Line >>"
CommandButton1.Default = True
CommandButton1.Accelerator = "S"
CommandButton2.Caption = "Cancel"
CommandButton2.Cancel = True
CommandButton2.Accelerator = "C"
CommandButton3.Caption = "Ok"
CommandButton3.Accelerator = "O"
Frame1.Caption = "Start Point"
Frame2.Caption = "End Point"
Label2.Caption = "x"
Label3.Caption = "y"
Label4.Caption = "z"
Label5.Caption = "x"
Label6.Caption = "y"
Label7.Caption = "z"

'retrieve the layers collection
Set AllLayers = ThisDrawing.Layers

'populate the list box with the
'layer names
For Each layer In AllLayers
    ListBox1.AddItem layer.Name
Next

'switch off the listbox and the texboxes
ListBox1.Enabled = False
ListBox1.BackColor = &HC0C0C0
TextBox1.Enabled = False
TextBox1.BackColor = &HC0C0C0
TextBox2.Enabled = False
TextBox2.BackColor = &HC0C0C0
TextBox3.Enabled = False
TextBox3.BackColor = &HC0C0C0
TextBox4.Enabled = False
TextBox4.BackColor = &HC0C0C0
TextBox5.Enabled = False
TextBox5.BackColor = &HC0C0C0
TextBox6.Enabled = False
TextBox6.BackColor = &HC0C0C0

End Sub
'----------------------------------

Private Sub CommandButton1_Click()
Dim ppoint(0 To 2) As Double
Dim spoint As Variant
Dim epoint As Variant
Dim layer As Object
Dim cnt As Integer

'set up the error trap
On Error GoTo ErrorTrap

'switch on the listbox and the textboxes
ListBox1.Enabled = True
ListBox1.BackColor = &H80000005
TextBox1.Enabled = True
TextBox1.BackColor = &H80000005
TextBox2.Enabled = True
TextBox2.BackColor = &H80000005
TextBox3.Enabled = True
TextBox3.BackColor = &H80000005
TextBox4.Enabled = True
TextBox4.BackColor = &H80000005
TextBox5.Enabled = True
TextBox5.BackColor = &H80000005
TextBox6.Enabled = True
TextBox6.BackColor = &H80000005

'******************************
'This is the part you've been
'waiting for.
'Hide the dialog
Me.Hide
'difficult hey??
'******************************

'select the line object
ThisDrawing.Utility.GetEntity theline, ppoint, vbCr & _
"Please Select a Line: "

'check if it's a line
If theline.EntityType <> acLine Then

Missed:
    
    'it's not a line - inform the user
    MsgBox "This is not a bloody line!!", _
    vbExclamation + vbOKOnly
    
Else

'It is a line so we can continue.
'First get the start and end points.
With theline
    spoint = .StartPoint
    epoint = .EndPoint
End With

'set the counter to zero
cnt = 0

'find out which layer the line is on, and
'then set the listbox index
For Each layer In AllLayers
    If theline.layer = layer.Name Then
        ListBox1.ListIndex = cnt
    Else
        cnt = cnt + 1
    End If
Next

'populate the textboxes with the start and end points
TextBox1.Text = Format(spoint(0), "0.00")
TextBox2.Text = Format(spoint(1), "0.00")
TextBox3.Text = Format(spoint(2), "0.00")
TextBox4.Text = Format(epoint(0), "0.00")
TextBox5.Text = Format(epoint(1), "0.00")
TextBox6.Text = Format(epoint(2), "0.00")

End If

GoThere:

'******************************
'And to unhide the dialog......
'redisplay the dialog
Me.Show
'Also very difficult!!!
'******************************
    
Exit Sub

'define the error trap
ErrorTrap:

    Select Case Err

        'if the user missed!!!
        Case -2147352567
        
            'let them try again
            Resume Missed
            
        'if there is another problem
        Case Else
        
            'tell the user what it is
            MsgBox "There was an error " _
            & Err.Number & ":" & _
            Err.Description, vbCritical
            Resume GoThere
            Resume

    End Select
   
End Sub
'---------------------------------

Private Sub CommandButton2_Click()
End
End Sub
'---------------------------------

Private Sub CommandButton3_Click()
End
End Sub
'---------------------------------

Private Sub ListBox1_Change()

'change the line to the layer selected
theline.layer = ListBox1.Value

'update the line
theline.Update

End Sub
'-----------------------------------

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

'change the line to the layer selected
theline.layer = ListBox1.Value

'update the line
theline.Update

End Sub
'------------------------------

Private Sub TextBox1_Change()
Dim thestartx As Variant

'get the start/end point of the line
thestartx = theline.StartPoint

'substitute the new co-ordinate
thestartx(0) = TextBox1.Text

'insert the new start/endpoint
theline.StartPoint = thestartx

'update the line
theline.Update

End Sub
'----------------------------

Private Sub TextBox2_Change()
Dim thestarty As Variant

thestarty = theline.StartPoint
thestarty(1) = TextBox2.Text
theline.StartPoint = thestarty
theline.Update

End Sub
'-----------------------------

Private Sub TextBox3_Change()
Dim thestartz As Variant

thestartz = theline.StartPoint
thestartz(2) = TextBox3.Text
theline.StartPoint = thestartz
theline.Update

End Sub
'-----------------------------

Private Sub TextBox4_Change()
Dim theendx As Variant

theendx = theline.EndPoint
theendx(0) = TextBox4.Text
theline.EndPoint = theendx
theline.Update

End Sub
'-----------------------------

Private Sub TextBox5_Change()
Dim theendy As Variant

theendy = theline.EndPoint
theendy(1) = TextBox5.Text
theline.EndPoint = theendy
theline.Update

End Sub
'-----------------------------

Private Sub TextBox6_Change()
Dim theendz As Variant

theendz = theline.EndPoint
theendz(2) = TextBox6.Text
theline.EndPoint = theendz
theline.Update

End Sub
'------------------------------

Of course, you will also need something to run your program with. Insert a new module and add this :

Load and run the program. A dialog will appear with a ListBox containing all the Layers within your drawing. You will find that none of the controls work with the exception of the Buttons. Press the "Select Line >>" button and the dialog will be hidden. Now, choose any line within your drawing. If you miss the line, or select an object that is not a line, a message box will appear informing you that you've messed up. Don't worry, the program will let you try again. Once you've mastered the art of selecting a line, the dialog will re-appear. The ListBox will now show you what layer your line is on, along with the x, y and z co-ordinates of the lines Start and End points.

Choose a different Layer in the ListBox. Notice how the line is immediately change to the new Layer? Now change one of the x or y co-ordinates. Again, the line is immediately updated and "moved" to the new set of co-ordinates. (Oh, by the way, no validation is performed on the values entered into the x, y and z co-ordinate TextBoxes. If you enter anything other than a number, I've a sneaky suspicion that the program may crash.)

Here's the source coding for all you lazy ones out there - Vba-Hide.zip (26 kb)