Ethernet shape - add connection

[Leigh]

I have a very cool macro that adds connections to an Ethernet shape.
The full code is included below. It works wonderfully -- take a minute
to copy the code into a Visio document, drag an Ethernet shape (from
the Basic Network Shapes stencil) onto the page, select the shape, then
run the macro. Oooooohhhh.

Now here's what I *can't* figure out. How can I associate the macro
with the shape's double-click event? I have tried saving the macro in a
module contained within the stencil file itself. But if I do, the
macro doesn't appear on the drop-down list under Format, Behavior,
Double-Click, Run macro.... I can manually copy the module into the
Visio drawing I'm working on (the one where I drop the shape), but
that's no solution. My fantasy: whenever I use the stencil and drag an
Ethernet shape onto *any* drawing, I want to double-click it and have
my nifty macro run.

OK Vizards -- how can I do that?

Here's the code:

Sub EthernetAddConnection()

Dim loEthernetShape As Visio.Shape
Dim loApp As Visio.Application
Dim loPage As Visio.Page
Dim loControlsSection As Visio.Section
Dim liGeometrySection As Integer
Dim liNewControl As Integer
Dim liCell As Integer

'Set loApp = Application
Set loEthernetShape = Application.ActiveWindow.Selection.Item(1)
If loEthernetShape.NameU <> "Ethernet" Then
MsgBox "Select an Ethernet shape, then try again",
vbExclamation, "Error: not an Ethernet shape"
Exit Sub
End If

'Get the Controls section
Set loControlsSection = loEthernetShape.Section(visSectionControls)

'Get a reference to the last existing control
Dim loExistingRow As Visio.Row
Set loExistingRow = loControlsSection.Row(loControlsSection.Count -
1)

'Add a new control
liNewControl = loExistingRow.Index + 1
loEthernetShape.AddRow visSectionControls, liNewControl, 0

'Set its cell formulae
'Get a ref to the row we just added
Dim loNewRow As Visio.Row
Set loNewRow = loControlsSection.Row(loExistingRow.Index + 1)

'Set the formulas so that this control will wake up just to
'the right and below the Ethernet shape
loNewRow.Cell(0).Formula = "Width*1.1"
loNewRow.Cell(1).Formula = "Height*-1.25"
loNewRow.Cell(2).Formula = "Controls.X" & liNewControl + 1
loNewRow.Cell(3).Formula = "Controls.YDyn"
loNewRow.Cell(4).Formula = "0"
loNewRow.Cell(5).Formula = "0"
loNewRow.Cell(6).Formula = "TRUE"
loNewRow.Cell(7).Formula = "Controls.Prompt"

'Add a new geometry section.
liGeometrySection =
loEthernetShape.AddSection(visSectionFirstComponent)

Dim loNewGeometrySection As Visio.Section
Set loNewGeometrySection =
loEthernetShape.Section(liGeometrySection)
Dim lsSectionName As String

'Insert its component row
loEthernetShape.AddRow liGeometrySection, visRowFirst + 0,
visTagComponent
Dim loThisRow As Visio.Row
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 0)
lsSectionName = "Geometry1"

'Set the formulas for the component row
loThisRow.Cell(0).Formula = "TRUE"
loThisRow.Cell(1).Formula = ""
loThisRow.Cell(2).Formula = "FALSE"
loThisRow.Cell(3).Formula = ""

'Add three rows for the geometry details
'First, the MoveTo
loEthernetShape.AddRow liGeometrySection, visRowFirst + 1,
visTagMoveTo
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 1)
'Enter the formulas
loThisRow.Cell(0).Formula = "Controls.X" & liNewControl + 1
loThisRow.Cell(1).Formula = "Controls.Y" & liNewControl + 1

'Next, a LineTo
loEthernetShape.AddRow liGeometrySection, visRowFirst + 2,
visTagLineTo
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 2)
'Enter the formulas
loThisRow.Cell(0).Formula = lsSectionName & ".X1"
loThisRow.Cell(1).Formula = "Height/2"

'Finally, another LineTo
loEthernetShape.AddRow liGeometrySection, visRowFirst + 3,
visTagLineTo
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 3)
'Enter the formulas
loThisRow.Cell(0).Formula = "Width/2"
loThisRow.Cell(1).Formula = lsSectionName & ".Y2"

End Sub

 

[JuneTheSecond]

The stencil is in the other project from the drawing, so you would check the
name of the project of the stencil, the macro woudl appear on the drop-down
list of project of stencil. If you would specify the project name, you could
associate the macro with the shape's double-click event. For example,
RUNMACRO("EthernetAddConnection","EtherNet")

 

[Chris [Visio MVP]]

You can leave the macro in the stencil and call it using the "CallThis"
function call.

Check the Developer's reference for how to implement CallThis.

In your shape, you'll have something like EventDblClick =
CallThis("MyProject.MyMacro")

In your code, you'll have a proc:

Public Sub MyMacro(visShape as visio.shape, args as string)
....
End Sub

If you close the stencil, the macro will no longer be available.

 

[JuneTheSecond]

And you would change a little in your code,
If Not loEthernetShape.NameU Like "Ethernet*" Then
instead of
If loEthernetShape.NameU <> "Ethernet" Then

 

[Leigh]

I don't understand. How do I "check the name of the project of the
stencil"? Is there a checkbox somewhere I missed? The project name
within the stencil is "FooProj", and the module name is "FooMod". But
the macro drop-down list doesn't have anything with "Foo" in it.

Also, when I try to put RUNMACRO(...) in the ShapeSheet EventDblClick
cell, I get an error message: "Error in formula", no matter what I put
inside the parentheses. I can't find RUNMACRO anywhere in Visio help
(regular help or VBA help).

Could you give me the step by step procedures to do what you're
suggesting?

BTW, Visio for Enterprise Architects 2003 SP-2, build 10.0.5110

 

[Leigh]

Thanks, Chris. I haven't downloaded the SDK, so I guess I should. Just
trying your suggestion though, nothing happens. In the stencil, the
project name is FooProj. The module name is FooMod. I changed the macro
to:

Public Sub EthernetAddConnection(aoVisShape As Visio.Shape, asArgs As
String)
MsgBox "Hello"
End Sub

In the ShapeSheet, I inserted the following into the EventDblClick
cell:

=CALLTHIS("FooProj.EthernetAddConnection")

When I double-click the shape, nothing happens at all.

I should have mentioned -- First, I dragged an Ethernet shape from my
stencil (where the macro project lives) to a blank Visio document. I
then selected it and chose Windows, Show ShapeSheet. In that
ShapeSheet, I edited the cell as shown above.

 

[Chris [Visio MVP]]

I get this screwed up every time.

Okay, it's

CallThis(procName, projName, arg1, arg2, ...)


I did made a couple of shapes:

CALLTHIS( "Module1.DoStuff", "Stencil2", "The message" )
CALLTHIS( "ThisDocument.DoStuff", "Stencil2", "The message" )

Calling:

Public Sub DoStuff(visShp As Visio.Shape, arg1 As String)
MsgBox arg1
End Sub

 

[JuneTheSecond]

You might catch instantly by these pictures
http://www.mster.co.jp/visiosquare/cgi-bin/cbbs/file/VisioProject.png
http://www.mster.co.jp/visiosquare/cgi-bin/cbbs/file/ShapeSheet.png

 

[Leigh]

Whoohoo! Thanks, Chris. For others who want to do this, open the Basic
Network Shapes stencil, then edit it. In the VB editor (Alt+F11),
rename the Basic_Ethernet_Shapes_ (or whatever it's called) project to
prjCustom. Insert a module, and call the module modCustom. In the
module, paste the following:

Option Explicit

Public Sub EthernetAddConnection(aoVisShape As Visio.Shape, asArgs As
String)

Dim loEthernetShape As Visio.Shape
Dim loApp As Visio.Application
Dim loPage As Visio.Page
Dim loControlsSection As Visio.Section
Dim liGeometrySection As Integer
Dim liNewControl As Integer
Dim liCell As Integer
Set loEthernetShape = aoVisShape
If Not loEthernetShape.NameU Like "Ethernet*" Then
MsgBox "Select an Ethernet shape, then try again",
vbExclamation, "Error: not an Ethernet shape"
Exit Sub
End If

'Get the Controls section
Set loControlsSection = loEthernetShape.Section(visSectionControls)

'Get a reference to the last existing control
Dim loExistingRow As Visio.Row
Set loExistingRow = loControlsSection.Row(loControlsSection.Count -
1)

'Add a new control
liNewControl = loExistingRow.Index + 1
loEthernetShape.AddRow visSectionControls, liNewControl, 0

'Set its cell formulae
'Get a ref to the row we just added
Dim loNewRow As Visio.Row
Set loNewRow = loControlsSection.Row(loExistingRow.Index + 1)

'Set the formulas so that this control will wake up just to
'the right and below the Ethernet shape
loNewRow.Cell(0).Formula = "Width*1.1"
loNewRow.Cell(1).Formula = "Height*-1.25"
loNewRow.Cell(2).Formula = "Controls.X" & liNewControl + 1
loNewRow.Cell(3).Formula = "Controls.YDyn"
loNewRow.Cell(4).Formula = "0"
loNewRow.Cell(5).Formula = "0"
loNewRow.Cell(6).Formula = "TRUE"
loNewRow.Cell(7).Formula = "Controls.Prompt"

'Add a new geometry section.
liGeometrySection =
loEthernetShape.AddSection(visSectionFirstComponent)

Dim loNewGeometrySection As Visio.Section
Set loNewGeometrySection =
loEthernetShape.Section(liGeometrySection)
Dim lsSectionName As String

'Insert its component row
loEthernetShape.AddRow liGeometrySection, visRowFirst + 0,
visTagComponent
Dim loThisRow As Visio.Row
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 0)
lsSectionName = "Geometry1"

'Set the formulas for the component row
loThisRow.Cell(0).Formula = "TRUE"
loThisRow.Cell(1).Formula = ""
loThisRow.Cell(2).Formula = "FALSE"
loThisRow.Cell(3).Formula = ""

'Add three rows for the geometry details
'First, the MoveTo
loEthernetShape.AddRow liGeometrySection, visRowFirst + 1,
visTagMoveTo
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 1)
'Enter the formulas
loThisRow.Cell(0).Formula = "Controls.X" & liNewControl + 1
loThisRow.Cell(1).Formula = "Controls.Y" & liNewControl + 1

'Next, a LineTo
loEthernetShape.AddRow liGeometrySection, visRowFirst + 2,
visTagLineTo
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 2)
'Enter the formulas
loThisRow.Cell(0).Formula = lsSectionName & ".X1"
loThisRow.Cell(1).Formula = "Height/2"

'Finally, another LineTo
loEthernetShape.AddRow liGeometrySection, visRowFirst + 3,
visTagLineTo
Set loThisRow = loNewGeometrySection.Row(visRowFirst + 3)
'Enter the formulas
loThisRow.Cell(0).Formula = "Width/2"
loThisRow.Cell(1).Formula = lsSectionName & ".Y2"

End Sub

Now drag an Ethernet shape onto a blank drawing. Select it. Choose
Window, Show ShapeSheet. Scroll down to the Events section (near the
bottom). Select the EventDblClick event, press F2 to edit it, and make
it say:

=CALLTHIS("modCustom.EthernetAddConnection","prjCustom","")

Close the ShapeSheet. Drag the Ethernet shape back onto your stencil.
Give it a useful name, like maybe "Ethernet MultiConnect". Save the
stencil.

That's it. No whenever you need an Ethernet shape with unlimited
connections, just drag your Ethernet Multiconnect shape onto a drawing,
and double-click it to add another connection.

Thanks again, Chris.