Sub FindStartingShapes()
Dim visPage As Visio.Page
Set visPage = Visio.ActivePage
Dim shp As Visio.Shape
For Each shp In visPage.Shapes
'Conditional Statement here
Next shp
End Sub
Quote from: Yacine on September 13, 2014, 11:04:02 PM
Hi Jean,
you won't find the answer in the shapes themselves, but rather in the connections collection of the page.
And better than a left/right check, you might check for a from/to relationship.
Wapperdude has done a lot of "connection stuff" lately. You may find some inspiration in his posts.
HTH,
Y.
Sub ShapeConnectionsShowTell()
Dim i As Integer
Dim conObj As Visio.Connect
Dim FromConShp As Visio.Shape
Dim selShp As Visio.Shape
Dim toPartID As Integer
Dim toConCon As String
If Visio.ActiveWindow.Selection.Count = 0 Then
MsgBox "Nothing selected: make selection and retry" 'Check for selection, if none, exit sub-routine
Exit Sub
End If
Set selShp = Visio.ActiveWindow.Selection(1)
For i = 1 To selShp.FromConnects.Count 'Get the connected from shapes, i.e., what is glued to the selected shape.
Set FromConShp = selShp.FromConnects(i).FromSheet 'This is shape glued to the selected shape.
For Each conObj In FromConShp.Connects 'Find shape connected to opposite end
'
' toConCon is the target connection point that you need to evaluate and then decide what to do
'
toPartID = conObj.ToPart 'This where glue connection made to the opposite end shape
If toPartID >= visConnectionPoint Then 'Check for named rows, use if present
If conObj.ToCell.RowName <> "" Then
toConCon = CStr("Connections." & conObj.ToCell.RowName)
Else
toConCon = CStr("Connections.Row_" & CStr(toPartID - visConnectionPoint + 1))
End If
End If
Next conObj
Next i
End Sub
Sub ttt()
Dim shp As Visio.Shape
Dim shId() As Integer
ReDim shId(2, 0)
For Each shp In ActivePage.Shapes
If shp.OneD Then
If shp.Connects.Count = 2 Then
Pos = UBound(shId, 2) + 1
ReDim Preserve shId(2, Pos)
If shp.Connects(1).ToPart = 101 Then
shId(1, Pos) = shp.Connects(1).ToSheet.ID
shId(2, Pos) = shp.Connects(2).ToSheet.ID
Else
shId(1, Pos) = shp.Connects(2).ToSheet.ID
shId(2, Pos) = shp.Connects(1).ToSheet.ID
End If
End If
End If
Next
For i = 1 To UBound(shId, 2)
Debug.Print shId(1, i) & " -> " & shId(2, i)
Next
End Sub
1 -> 4 1 -> 5 4 -> 11 2 -> 5 5 -> 13 |
Quote from: wapperdude on September 15, 2014, 04:40:49 PM
My initial thoughts go something like:
a. The selected shape connections code is a good starting place.
i. It uses the selected shape as the basis for beginning the search
ii. It has code that allows writing to an Excel file
iii. It captures the 2nd shape in the path of shapes, e.g., A--> C, D.
b. The code needs additional changes:
i. Existing code needs to eliminate writing 1D shapes into Excel, i.e., only "A", "C". and "D" would be written to Excel
ii. When the 2nd shape is captured, e.g., "C", it becomes the new selected shape at some point, and the process iterates thru, eventually, the final shape would be reached.
iii. alternative might be to additionally store A, C, and D into a temporary array. Then using the array, go thru each connections collection to gather additional info. This might be more efficient. Namely, rather than writing to Excel with each new discovery, gather all of the objects (2D shapes) into an array, and write to Excel once, after the entire page has been analyzed and all appropriate discoveries have been stored in the array.
Either way, there will be multiple iterations to get desired shape collections.
HTH
Wapperdude