Examining Connections

M

Markus Breugst

Dear All,

this posting is not a question but maybe helpful for those of you who want
to analyze a Visio drawing programmatically. I wrote the following macro for
myself some time ago in order to learn about the shape properties that store
information about connections. Handling this stuff may be a bit complicated
at the beginning, and so the VBA code is meant to provide some help in
understanding.

Before using the macro, just create some simple shapes (such as rectangles)
on the first page of your drawing and connect them with each other using
1d-shapes. The macro "ShowConnectionProps" will write all
connection-relevant information into the shape texts.

(Of course I exclude liability for any effects caused by this code. Just
look at it and decide for yourself if you dare to use it :)

Best regards,
Markus



Public Sub ShowConnectionProps()
Dim myShape As Shape
Dim index As Integer
Dim index2 As Integer
Dim myConnects As Connects
Dim fromShape As Shape
Dim toShape As Shape
Dim fromPart As Integer
Dim toPart As Integer
Dim shapeText As String
Dim fromPartText As String
Dim toPartText As String

For index = 1 To ThisDocument.Pages(1).Shapes.Count
Set myShape = ThisDocument.Pages(1).Shapes(index)
shapeText = myShape.NameID + Chr(10) + Chr(10)

For index2 = 1 To myShape.Connects.Count
Set toShape = myShape.Connects(index2).ToSheet
fromPart = myShape.Connects(index2).fromPart
toPart = myShape.Connects(index2).toPart
GetToPartText toPart, toPartText
GetFromPartText fromPart, fromPartText
If Not (toShape Is Nothing) Then
shapeText = shapeText + "Connects.To_" + Format(index2,
"00") + ": " + toShape.NameID + " (" + fromPartText + " -> " + toPartText +
")" + Chr(10)
End If
Next index2
For index2 = 1 To myShape.FromConnects.Count
Set fromShape = myShape.FromConnects(index2).FromSheet
fromPart = myShape.FromConnects(index2).fromPart
toPart = myShape.FromConnects(index2).toPart
GetToPartText toPart, toPartText
GetFromPartText fromPart, fromPartText
If Not (fromShape Is Nothing) Then
shapeText = shapeText + "FromConnects.From_" +
Format(index2, "00") + ": " + fromShape.NameID + " (" + fromPartText + " ->
" + toPartText + ")" + Chr(10)
End If
Next index2

myShape.Text = shapeText
Next index
End Sub

Public Sub GetToPartText(part As Integer, partString As String)
If part = 0 Then
partString = "None"
ElseIf part = 1 Then
partString = "GuideX"
ElseIf part = 2 Then
partString = "GuideY"
ElseIf part = 3 Then
partString = "WholeShape"
ElseIf part = 4 Then
partString = "GuideIntersect"
ElseIf part = 7 Then
partString = "toAngle"
ElseIf part >= 100 Then
partString = "ConnectionPoint_" + Format(part - 99, "00")
Else
partString = Format(part, "000")
End If
End Sub

Public Sub GetFromPartText(part As Integer, partString As String)
If part = 0 Then
partString = "None"
ElseIf part = 1 Then
partString = "LeftEdge"
ElseIf part = 2 Then
partString = "CenterEdge"
ElseIf part = 3 Then
partString = "RightEdge"
ElseIf part = 4 Then
partString = "BottomEdge"
ElseIf part = 5 Then
partString = "MiddleEdge"
ElseIf part = 6 Then
partString = "TopEdge"
ElseIf part = 7 Then
partString = "BeginX"
ElseIf part = 8 Then
partString = "BeginY"
ElseIf part = 9 Then
partString = "Begin"
ElseIf part = 10 Then
partString = "EndX"
ElseIf part = 11 Then
partString = "EndY"
ElseIf part = 12 Then
partString = "End"
ElseIf part = 13 Then
partString = "FromAngle"
ElseIf part = 14 Then
partString = "FromPin"
ElseIf part >= 100 Then
partString = "ConnectionPoint_" + Format(part - 99, "00")
Else
partString = Format(part, "000")
End If

End Sub
 
M

Michel LAPLANE

Interesting code
Markus Breugst said:
Dear All,

this posting is not a question but maybe helpful for those of you who want
to analyze a Visio drawing programmatically. I wrote the following macro
for myself some time ago in order to learn about the shape properties that
store information about connections. Handling this stuff may be a bit
complicated at the beginning, and so the VBA code is meant to provide some
help in understanding.

Before using the macro, just create some simple shapes (such as
rectangles) on the first page of your drawing and connect them with each
other using 1d-shapes. The macro "ShowConnectionProps" will write all
connection-relevant information into the shape texts.

(Of course I exclude liability for any effects caused by this code. Just
look at it and decide for yourself if you dare to use it :)

Best regards,
Markus



Public Sub ShowConnectionProps()
Dim myShape As Shape
Dim index As Integer
Dim index2 As Integer
Dim myConnects As Connects
Dim fromShape As Shape
Dim toShape As Shape
Dim fromPart As Integer
Dim toPart As Integer
Dim shapeText As String
Dim fromPartText As String
Dim toPartText As String

For index = 1 To ThisDocument.Pages(1).Shapes.Count
Set myShape = ThisDocument.Pages(1).Shapes(index)
shapeText = myShape.NameID + Chr(10) + Chr(10)

For index2 = 1 To myShape.Connects.Count
Set toShape = myShape.Connects(index2).ToSheet
fromPart = myShape.Connects(index2).fromPart
toPart = myShape.Connects(index2).toPart
GetToPartText toPart, toPartText
GetFromPartText fromPart, fromPartText
If Not (toShape Is Nothing) Then
shapeText = shapeText + "Connects.To_" + Format(index2,
"00") + ": " + toShape.NameID + " (" + fromPartText + " -> " + toPartText
+ ")" + Chr(10)
End If
Next index2
For index2 = 1 To myShape.FromConnects.Count
Set fromShape = myShape.FromConnects(index2).FromSheet
fromPart = myShape.FromConnects(index2).fromPart
toPart = myShape.FromConnects(index2).toPart
GetToPartText toPart, toPartText
GetFromPartText fromPart, fromPartText
If Not (fromShape Is Nothing) Then
shapeText = shapeText + "FromConnects.From_" +
Format(index2, "00") + ": " + fromShape.NameID + " (" + fromPartText +
" -> " + toPartText + ")" + Chr(10)
End If
Next index2

myShape.Text = shapeText
Next index
End Sub

Public Sub GetToPartText(part As Integer, partString As String)
If part = 0 Then
partString = "None"
ElseIf part = 1 Then
partString = "GuideX"
ElseIf part = 2 Then
partString = "GuideY"
ElseIf part = 3 Then
partString = "WholeShape"
ElseIf part = 4 Then
partString = "GuideIntersect"
ElseIf part = 7 Then
partString = "toAngle"
ElseIf part >= 100 Then
partString = "ConnectionPoint_" + Format(part - 99, "00")
Else
partString = Format(part, "000")
End If
End Sub

Public Sub GetFromPartText(part As Integer, partString As String)
If part = 0 Then
partString = "None"
ElseIf part = 1 Then
partString = "LeftEdge"
ElseIf part = 2 Then
partString = "CenterEdge"
ElseIf part = 3 Then
partString = "RightEdge"
ElseIf part = 4 Then
partString = "BottomEdge"
ElseIf part = 5 Then
partString = "MiddleEdge"
ElseIf part = 6 Then
partString = "TopEdge"
ElseIf part = 7 Then
partString = "BeginX"
ElseIf part = 8 Then
partString = "BeginY"
ElseIf part = 9 Then
partString = "Begin"
ElseIf part = 10 Then
partString = "EndX"
ElseIf part = 11 Then
partString = "EndY"
ElseIf part = 12 Then
partString = "End"
ElseIf part = 13 Then
partString = "FromAngle"
ElseIf part = 14 Then
partString = "FromPin"
ElseIf part >= 100 Then
partString = "ConnectionPoint_" + Format(part - 99, "00")
Else
partString = Format(part, "000")
End If

End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

AddPicturesToShapes 0
Word macro that can call cells out of Excel for a find and replace 0
Trying to Extract Embedded OLEs 0
VBA Export to PDF 0
Match style 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
VBA Coding Help for Beginner 0
Making a macro only work on certain files 2

Top