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
:
Public Sub HideDialog()
UserForm1.Show
End Sub
|
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.)
Play with it, have
fun..........
Here's the source coding
for all you lazy ones out there - Vba-Hide.zip
(26 kb) |