Automation = Productivity
in Visio
David A
Edson
Greetin’s tae a’ ye folk oot
thar!!! Grand tae see ye back!!! This month’s column is in response to a question
sent tae me from a new Visio user.His question was:
"I was hoping you might be able to help me with a
little bit of shape development. I want to create a circle of X diameter then add
additional circles with Y diameter to the circumference and get them to appear
equi-spaced. I need this to occur via automation, without having to place the shapes
individually and work out the spacing. It should appear as follows… "
Equi-spaced automated shape
Weel… let it no’ be said tha’ the Auld
Scotsman will nae lend a hand tae help folk create brilliant Visio solutions.
Let’s analyse the problem first. The user needs to be
able to specify a centre point for the major circle. Once this point is specified, there
are three parameters that need to be input to generate the proper figure: The diameter of
the major circle "X", the diameter of the ‘n’ number of minor circles
"Y", and the ‘n’ number of minor circles to be equally spaced along
the circumference of the major circle. To solve this construction problem we will use a
combination of a single Visio Shape and a few simple VBA routines with a VBA dialogue for
the User Input.
We will begin with the Visio shape. The purpose of this
shape is twofold; first to allow the user to graphically "drop" the shape where
he or she needs the major circle to be centered, and secondly to trigger off the VBA code
that will display the dialogue, accept the user input and then calculate and generate the
appropriate figure as Visio Shapes. Note that once the Visio "target" shape is
dropped, it will be deleted.
I have designed the target shape to look like an actual
target, shown below.
Target shape
There is nothing all that special
about the target shape. It is simply a shape for the user to drag from a stencil and drop
out on to the page. There are however a few things that have been done to ensure that the
shape does exactly what it is supposed to. Firstly, the shape was given an exacting name.
I happened to call it "DropTarget". Secondly in the Events Section of the
DropTarget’s ShapeSheet, in the EventDrop cell, I have filled in the following
function: =RUNADDON("ShowCircForm").
The function is as follows:
Public Sub
ShowCircForm()
' note that this function is called
' from the EventDrop cell in the Events
' section of the Target shape. When
' the target shape is dropped it
' immediately calls this function
' which loads the VBA form and awaits
' the
user filling in the fields and then
' either clicking the OK or CANCEL buttons
UserForm1.Show
' simply make a call to the show method
' of
the user form to display the user form
'
allowing the user to fill in the values for
' the size of the major circle, minor circle
' and
number of minor circles
End Sub
This function has but one purpose to run a
bit of VBA code that initializes and activates a VBA form which looks like the form shown
in figure 3 below.
VBA Input form
The VBA Form has three Label
controls, three TextBox controls, and two CommandButton controls. The Label controls are
obvious and we’ll no’ concearn oorsel’s with their names. You can create
them to suit your own tastes. The three TextBox controls are as follows:
- MajCirc – this will hold the Major Circle’s
Diameter value
- MinCirc – this will hold the Minor Circle’s
Diameter value
- NumCirc – this will hold the number of Minor Circles to
be generated
The two CommandButton controls are as follows:
- cmdOK – this will trigger the code to validate the
TextBox control entries and then generate the shapes
- cmdCxl – this will cancel the operation
There is no code behind the three TextBox controls. The
controls simply act as repositories for the input of the values by the user. However when
the user clicks on the CANCEL button, the following code is evaluated:
Private Sub
cmdCxl_Click()
' if the user clicks the cancel button
' then simply close and unload the form
' and do nothing else
Unload UserForm1
End Sub
When the user clicks on the OK button, the following code is
evaluated:
Private Sub
cmdOK_Click()
Dim DirtyFlag As Integer
' a number to determine the user erro
Dim ReportTxt As String
' a text holder for the error message
' first we initialise the dirty flag to
' zero which tells us it is OK
' to run the function and that all
' fields have been properly filled in
DirtyFlag = 0
' if the user did not fill in the Major
' Circle Size field then set
' the dirty flag to an incremental value of +1
If MajCirc.Text = "" Then DirtyFlag = DirtyFlag + 1
' if the user did not fill in the Minor
' Circle Size field then set
' the dirty flag to an incremental value of +2
If MinCirc.Text = "" Then DirtyFlag = DirtyFlag + 2
' if the user did not fill in the Number of
' Circles field then set the dirty flag to
' an incremental value of +4
If NumCirc.Text = "" Then DirtyFlag = DirtyFlag + 4
' use a select case statement to analyze
' which value the dirty flag is currently
' set to. Only if the dirty flag remains
' at zero do we continue to process otherwise
' we set the error message
Select Case DirtyFlag
Case 1
ReportTxt = "Value for Major Circle has been left Blank."
Case 2
ReportTxt = "Value for Minor Circle has been left Blank."
Case 4
ReportTxt = "Value for Number of Circles has been left Blank."
Case 3
ReportTxt = "Value for Circle Sizes have been left Blank."
Case 7
ReportTxt = "Value for All fields have been left Blank."
Case 5
ReportTxt = "Value for Major Circle and Number of Circles have been left Blank."
Case 6
ReportTxt = "Value for Minor Circle and Number of Circles have been left Blank."
End Select
' if the dirty flag is non-zero,
' i.e. a field is left blank process the
' proper error message and go back to the dialog
If DirtyFlag <> 0 Then
MsgBox ReportTxt, vbInformation, "User Correction Required"
' otherwise call the MakeCircArray
' Subroutine and then unload the user form
Else
MakeCircArray
Unload UserForm1
End If
End Sub
I’m not going to go into an explanation of the code,
since as you read the "verra verbose" commenting, you will, I am sure, fully
understand its purpose. The Visio Drawing which accompanies this article has all of the
code saved within it, and you may feel free to us it as necessary.
Note that the OK event first checks to see that the user has
indeed filled in all of the required fields. If any are left blank, then back to the
dialogue they go, an’ nae wee dram fer them!!!
The cmdOK_Click procedure calls another procedure,
MakeCircArray. This function takes the input from the User Form and utilizing this input,
generates the required shapes. Read carefully the verbose comments in the procedure as
they will fully explain how this procedure works.
Public MajCircVal As String
' universally accessable variable to hold Major Circle Size
Public MinCircVal As String
' universally accessable variable to hold Minor Circle Size
Public NumCircVal As Integer
' universally accessable variable to hold Number of Minor Circles Value
Public Sub MakeCircArray()
Dim shTargetShape As Visio.Shape
'the target shape being dropped from the local stencil
Dim ceTSPinX As Visio.Cell
' The PinX cell of the Target Shape
Dim ceTSPinY As Visio.Cell
' The PinY cell of the Target Shape
Dim shXShape As Visio.Shape
' The Major Circle Shape
Dim DiamMaj As Double
' The Major Circle Diameter value in internal units (inches)
Dim DiamMin As Double
' The Minor Circle(s) Diameter value in internal units (inches)
Dim ULX As Double
' The Upper Left X Value to draw a circle in internal units (inches)
Dim ULY As Double
' The Upper Left Y Value to draw a circle in internal units (inches)
Dim LRX As Double
' The Lower Right X Value to draw a circle in internal units (inches)
Dim LRY As Double
' The Lower Right Y Value to draw a circle in internal units (inches)
Dim shNthYShape As Visio.Shape
' The Minor Circle(s) Shape
Dim AngInDeg As Double
' The spacing angle between minor circles in degrees
Dim AngInRad As Double
' The spacing angle between minor circles in radians
Dim LoopCount As Integer
' A counter for running through itterations of the For Loop
' get a reference to the target shape that was just dropped
Set shTargetShape = Visio.ActivePage.Shapes.Item("DropTarget")
' get a reference to the target shape PinX cell
Set ceTSPinX = shTargetShape.Cells("PinX")
' get the value in the PinX cell in internal units (inches)
LocateXMaj = ceTSPinX.Result("in")
' get a reference to the target shape PinY cell
Set ceTSPinY = shTargetShape.Cells("PinY")
' get the value in the PinX cell in internal units (inches)
LocateYMaj = ceTSPinY.Result("in")
' this will be the point at which we place the center of the major circle
' since we are now done with the target shape,
' it having been dropped where we want the
' new major circle to be created, we will now
' delete the target shape. Note that we now
' have the coordinates of that drop point in
' LocateXMaj and LocateYMaj
shTargetShape.Delete
' now read in the value for the diameter of
' the major circle from the text box in the
' user form. Note we use the VAL() function to
' convert it from a string to a double and
' truncate off any units. Here we would need to
' convert to a metric size if that were
' necessary
DiamMaj = Val(UserForm1.MajCirc.Text)
' now read in the value for the number of the
' minor circles from the text box in the
' user form. Note we use the VAL() function to
' convert it from a string to a double.
NumCircVal = Fix(Val(UserForm1.NumCirc.Text))
' now we calculate the upper left hand x ordinate
' of the circle we need to draw for
' the major circle. You will note in a moment
' that the DrawOval() function needs to
' have passed as arguments, the X, and Y values
' for the Upper Left and the X, and Y
' values for the Lower Right corners of the
' bounding box that will contain the circle.
' we calculate this point by subtracting half
' of the diameter from the calculated centre point
ULX = LocateXMaj - (DiamMaj / 2)
' now we calculate the upper left hand y abcissa
' of the circle we need to draw for the major circle.
' we calculate this point by adding half of the
' diameter from the calculated centre point
ULY = LocateYMaj + (DiamMaj / 2)
' now we calculate the lower right hand x ordinate
' of the circle we need to draw for the major circle.
' we calculate this point by adding half of the
' diameter from the calculated centre point
LRX = LocateXMaj + (DiamMaj / 2)
' now we calculate the lower right hand y abcissa
' of the circle we need to draw fo the major circle.
' we calculate this point by subtracting half of
' the diameter from the calculatedcentre point
LRY = LocateYMaj - (DiamMaj / 2)
' we now call the DrawOval method of the
' ActivePage object with the proper arguments
' calculated above and generate the major circle
' and hold its reference
Set shXShape = Visio.ActivePage.DrawOval(ULX, ULY, LRX, LRY)
' here we will begin a loop for each one of the
' minor circles that we want to generate
' loop from 1 to the number retrieved from
' the dialog and converted
For LoopCount = 1 To NumCircVal
' we now take the number of minor circles that
' we obtained above and divide 360 degrees
' by this number to determine the angle in
' degrees between each of the minor circles
' to set the first angle to zero and then be
' able to continually increase the displacement
' angle with each loop, we start with a value 1
' less than the loop count, i.e. 0 the first time.
' Then we use this value as a multiplier to gain
' the angle we need in degrees
AngInDeg = (360 / NumCircVal) * (LoopCount - 1)
' we now multiply that angle in degrees value by
' a number representing the conversion from degrees
' to radians (PI over 180)
AngInRad = AngInDeg * (3.1415926 / 180)
' now begins a somwhat complex compound IF statement.
' Here we are checking which one of the 4 quadrants
' of a Cartesian plane the given angle falls into.
' This will determine whether we add or subtract
' the value for the minor circles center point from
' or to the value for the center point of the major
' circle thusly:
'
' |
' Quad=2 | Quad=1
' X = - | X = +
' Y = + | Y = +
' -------------+-------------
' |
' Quad=3 | Quad=1
' X = - | X = +
' Y = - | Y = -
' |
'
' if the angle is between 0 radians and PI/2
' i.e. Quad=1
If AngInRad <= (pi / 2) Then
' then add the Major Circle diameter divided
' by 2 and multiplied by the Cosine of
' the angle to the X value of the Major
' Circle's centre point to calculate
' the X position of that particular minor circle
LocateXMin = LocateXMaj + ((DiamMaj / 2) * Cos(AngInRad))
' then add the Major Circle diameter divided
' by 2 and multiplied by the Sine of
' the angle to the Y value of the Major
' Circle's centre point to calculate
' the Y position of that particular minor circle
LocateYMin = LocateYMaj + ((DiamMaj / 2) * Sin(AngInRad))
' otherwise if the angle is between PI/2
' and PI i.e. Quad=2
ElseIf AngInRad <= pi Then
' then subtract the Major Circle diameter divided
' by 2 and multiplied by the Cosine of
' the angle from the X value of the Major
'Circle's centre point to calculate
' the X position of that particular minor circle
LocateXMin = LocateXMaj - ((DiamMaj / 2) * Cos(AngInRad))
' then add the Major Circle diameter divided
' by 2 and multiplied by the Sine of
' the angle to the Y value of the Major
' Circle's centre point to calculate
' the Y position of that particular minor circle
LocateYMin = LocateYMaj + ((DiamMaj / 2) * Sin(AngInRad))
' otherwise if the angle is between PI
' and (3*PI)/2 i.e. Quad=3
ElseIf AngInRad <= (3 * (pi / 2)) Then
' then subtract the Major Circle diameter
' divided by 2 and multiplied by the Cosine of
' the angle from the X value of the Major
' Circle's centre point to calculate
' the X position of that particular minor circle
LocateXMin = LocateXMaj - ((DiamMaj / 2) * Cos(AngInRad))
' then subtract the Major Circle diameter divided
' by 2 and multiplied by the Sine of
' the angle from the Y value of the Major Circle's
' centre point to calculate the Y position of that
' particular minor circle
LocateYMin = LocateYMaj - ((DiamMaj / 2) * Sin(AngInRad))
' otherwise if the angle is between (3*PI)/2
' and 2*PI i.e. Quad=4
Else
' then add the Major Circle diameter divided by 2
' and multiplied by the Cosine of the angle to the
' X value of the Major Circle's centre point to calculate
' the X position of that particular minor circle
LocateXMin = LocateXMaj + ((DiamMaj / 2) * Cos(AngInRad))
' then subtract the Major Circle diameter divided
' by 2 and multiplied by the Sine of the angle from
' the Y value of the Major Circle's centre point to
' calculate the Y position of that particular minor circle
LocateYMin = LocateYMaj - ((DiamMaj / 2) * Sin(AngInRad))
' end the If Statement block
End If
' now read in the value for the diameter of the
' minor circle from the text box in the user form.
' Note we use the VAL() function to convert it
' from a string to a double and truncate off any units.
' Here we would need to convert to a metric size if
' that were necessary
DiamMin = Val(UserForm1.MinCirc.Text)
' now we calculate the upper left hand x ordinate
' of the circle we need to draw for the minor circle.
' we calculate this point by subtracting half of the
' diameter from the calculated centre point
ULX = LocateXMin - (DiamMin / 2)
' now we calculate the upper left hand y abcissa
' of the circle we need to draw for the minor circle.
' we calculate this point by adding half of the
' diameter from the calculated centre point
ULY = LocateYMin + (DiamMin / 2)
' now we calculate the lower right hand x ordinate
' of the circle we need to draw for the minor circle.
' we calculate this point by adding half of the
' diameter from the calculated centre point
LRX = LocateXMin + (DiamMin / 2)
' now we calculate the lower right hand y abcissa
' of the circle we need to draw for the minor circle.
' we calculate this point by subtracting half of the
' diameter from the calculated centre point
LRY = LocateYMin - (DiamMin / 2)
' we now call the DrawOval method of the ActivePage
' object with the proper arguments calculated above
' and generate the minor circle and hold its reference
Set shNthYShape = Visio.ActivePage.DrawOval(ULX, ULY, LRX, LRY)
' we then hit the end of the designated loop and
' return to the top of the loop
Next LoopCount
' this is the entire routine. end of subroutine
End Sub
That is truly a’ thar is tae performin’ the
automation folks!!! You can begin to see that by creating a little VBA code and with the
added benefit of a Visio SmartShape Symbols, you can create fast and powerful solutions to
real world problems.
As an added thocht process lads an’ lassies…
Imagine if you were to array shapes that were roughly
rectangular in shape tapering to the outside of the circle and lapping over the
circumference of the circle. Now imagine that you were able to generate the array as we
have just done, followed by a Union operation and the setting of a given fillet radius to
all vertices under full automation. The resulting figure would be a Gear!!! Yes… it
is possible to create a full gear generation application using only a wee bit mir code
than what you have been presented wi’ here!!!
Have fun creating your own solutions and "Haste ye back."
Dave
"The Auld Scotsman" Edson
Dave's
Hot Download
A Visio drawing with the target shape defined, programmed and
ready to rock and roll... or highland fling... as the case may be...
Cogs.zip (31kb) |
|
