I'm looking to completely automate my electrical connector shapes from this thread (http://visguy.com/vgforum/index.php?topic=8103.msg36281#new).
I think wapperdude's code here (http://visguy.com/vgforum/index.php?topic=5664.msg22613#msg22613) contains the answer, but I'm still a complete noobie at this VBA stuff.
In my current configuration, I add my connection points by right-clicking the shape after stretching my shape to the desired length. I originally had my macro fire in the event section when I dropped the shape and then again when I stretched the shape, but I ran into a problem if I contracted the shape with all the previously added connection points. My solution was to 'park' the collapsed connection points on the lower right corner of the shape, but I'd like to delete them instead of just park them.
More specifically, I want to test to see if there is a connector attached to a connection point, and if so, 'park' it as I currently do, and if not, then delete them. This way there is no interaction needed from the user other than to just use the shape.
My problem is figuring out how to tell if a connector of any kind is attached to a specific connection point. I'm brand spanking new to VBA, so if you wouldn't mind point me in the right direction, I'd be ever so grateful.
The last piece of the puzzle is making this macro available to all previous drawings. It currently resides in our drawing template, but I'd prefer to attach it directly to the stencil that contains the shapes. I'm just not sure how to do that part, either.
EDIT: Looks like I found the answer (http://visguy.com/vgforum/index.php?topic=359.msg1568#msg1568) to the stencil VBA availability issue. I'll play with that and see if I can get it to work like I need. Still working on the other part concerning connection points.
Connectivity info resides in connectors (or other 1D shapes). So, you have to loop thru the connectors on a page and check to what each end is connected. What I developed was for V2007, and beginning with V2010, the object model has new features that simplify things. See https://msdn.microsoft.com/en-us/vba/visio-vba/articles/shape-connectedshapes-method-visio (https://msdn.microsoft.com/en-us/vba/visio-vba/articles/shape-connectedshapes-method-visio) This link gives some simple code examples.
The following link may be helpful: http://visguy.com/vgforum/index.php?topic=4414.msg17222#msg17222 (http://visguy.com/vgforum/index.php?topic=4414.msg17222#msg17222)
Wapperdude
Okay, so this is a bit more complicated than I thought, so let me see if I get the logic right. See attached image for reference.
(https://i.imgur.com/Xet5mJO.png)
Say I dropped the connector on the page, stretched it, and ran my macro to add connection points. I then added connectors to the shape. Later, I 'shrank' my shape, and so the logic in my shape puts any connection points that don't fit on the shape at X=Width*1, Y=0. I want to the macro to automatically delete all of those connection points except for the one that has the connector attached to it. This way, the user could address his connector issue and make a decision as to what to do with it or the shape.
So given the above post, I think the logic would work like something like this:
1. If I have my macro set to fire at EventFXMod, it will check the Y-dimension of the shape then place connection points in the shapesheet of the shape. The connection points themselves are IF statements checking for the shape dimensions and then routing to Width*1,0 if they don't belong.
2. I need my macro to then loop through all the connectors connected to my selected shape, if any, using code similar to what you linked above, probably with an ELSE statement based on the height test in my macro (i.e. IF tall enough, add connection points, ELSE if too tall, delete them IF not connected to a connector).
3. If any of those connectors are at the shape location of Width*1,0, determine which cell in the shapesheet of the shape are attached to that connector (not sure how to do this part).
4. Another loop that deletes any connection points that are a) at Width*1,0 AND b). not noted in #3 above.
Is this logic about right? Is there a more efficient way to do what I'm trying to accomplish?
I think #3 is where I need the help. How do I determine which connection point in my shape's shapesheet is associated with a connector that is attached to it?
Yes, that's the basic process.
WRT step 3, first, store the I'd of your selected shape, then step thru all of the connectors on the page. For each connector, use the connectors method to identify what shape is connected to each end. If the shape matches your selected shape, then you can use the properties of that shape. From those propeerties you can determine the specific connection point. See https://msdn.microsoft.com/en-us/vba/visio-vba/articles/connect-tocell-property-visio (https://msdn.microsoft.com/en-us/vba/visio-vba/articles/connect-tocell-property-visio), and https://msdn.microsoft.com/en-us/vba/visio-vba/articles/connect-fromcell-property-visio (https://msdn.microsoft.com/en-us/vba/visio-vba/articles/connect-fromcell-property-visio).
To loop thru the connectors, you can do this:
Dim vsoShapes As Visio.Shapes
Dim vsoShape As Visio.Shape
Dim vsoConnects As Visio.Connects
Dim vsoConnect As Visio.Connect
Dim intCounter As Integer
For intCounter = 1 To vsoConnects.Count
Set vsoConnect = vsoConnects(intCounter)
' more code here to check results
Next
Wapperdude
So I have some of the code working, but interestingly enough I'm having trouble deleting rows based on content. Basically, if all my conditionals are met in the loop, I'm wanting to delete any row in the connection points section where the Y column = 0. I think I'm having problem getting to the individual rows, and logically, I figured starting at the last row and moving up would make the most sense as that would match the behavior of the shape.
For I = 0 To C - 1
intRowIndex = ActiveWindow.Selection(1).RowExists(visSectionConnectionPts, visRowLast, visTagCnnctPt)
Set vsoRow = ActiveWindow.Selection(1).Section(visSectionConnectionPts).Row(intRowIndex)
If vsoRow.Cell(visCnnctY).ResultIU = 0 Then
vsoShape.DeleteRow visSectionConnectionPts, visRowConnectionPts
End If
Next I
The Set vsoRow always fails, and I can't figure out why. Any insights?
See this: https://msdn.microsoft.com/en-us/vba/visio-vba/articles/shape-deleterow-method-visio (https://msdn.microsoft.com/en-us/vba/visio-vba/articles/shape-deleterow-method-visio)
Wapperdude
Also see this post. JuneTheSecond provides some code: http://visguy.com/vgforum/index.php?topic=5314.0 (http://visguy.com/vgforum/index.php?topic=5314.0)
Wapperdude
I looked at those and a few others and came up with this, which seems to be working except that I vsoCell ALWAYS returns 0 instead of the contents of the cell.
For I = C To 1 Step -1
Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, I, visCnnctY)
CXN = vsoCell.ResultIU()
If CXN = 0 Then
vsoShape.DeleteRow visSectionConnectionPts, visRowLast
End If
Next I
It is incrementing correctly and deleting the last row, and at one point I was getting the proper value for vsoCell. I was changing other things to get the rest of the behavior correct, and now it only returns zero.
I think I got it!
If C > N Then
For I = C To 1 Step -1
Set vsoCell = vsoShape.CellsSRC(visSectionConnectionPts, I, visCnnctY)
CXN = vsoShape.Cells("Connections.Y" & I).ResultIU
If CXN = 0 Then
vsoShape.DeleteRow visSectionConnectionPts, visRowLast
End If
Next I
End If
Your code has a potential problem. You loop thru the rows using an index counter "I", to find "qualifying" row. But, your delete row command always invokes last row. Row "I" is not necessarily the last row. Following code works...
Wapperdude
Sub mac2()
Dim vsoShp As Shape
Dim i As Integer
Dim vsoCell As Cell
Dim maxRow As Integer
Set vsoShp = ActiveWindow.Selection(1) 'Selected shape
maxRow = vsoShp.RowCount(visSectionConnectionPts) - 1 'this is max row count/last row
For i = maxRow To 0 Step -1
Set vsoCell = vsoShp.CellsSRC(visSectionConnectionPts, i, visCnnctY)
CXN = vsoCell.Result(none)
If CXN = 0 Then
vsoShp.DeleteRow visSectionConnectionPts, i
End If
Next
End Sub
Wapperdude
Wapperdude, thank you! While this thread topic has morphed from the original intent, the correction of my code actually helps me fix the next problem issue I have.
As it sits right now, the code works perfectly when placing the shape, it automagically adds all my connection points on the Width*1 surface, and removes those that are not needed, all based on the height of the shape.
It turns out I didn't need to know if the connection points had connectors attached or not, as deleting the connection point doesn't delete the connector anyway.
My next iteration of this code is to call the function with a right-click menu selection to add connection points at Width*0, all with the same behavior as I now currently have.
To implement this, I intend to pass an argument with the function call based on either the right click or event section and set the behavior accordingly. Adding at Width*0 is not used as often, so I don't need the initial addition of these connection points to be automatic, but once they are there, I'd like them to behave as the Width*1 points.
I'll attache a VSD with the Macro I currently have shortly.
Bah, I'm on vacation and now I'm having dreams about this damn program. I guess that's what happens when you're an engineer.
I have the logic mostly worked out, but I'm missing something in the implementation.
General Logic:If CR < N
Add connection Points on the right
If CL < N
IF chk = 0 OR CL > 1
Add Connection Points on the left
End If
If CR > N OR If CL > N
Remove Connection Points from left or right
Here's the problem. My implementation is not working, and things are out of order, and I think it's all about this statement in each for loop: If CR < N Then
For I = CR + 1 To N
intRowIndex = vsoShape.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)
WString = "Width*1"
'Used for the Height Dimension of the connector to place the connection points
G = vsoShape.Cells("Scratch.X1").ResultIU
HString = "IF(Height*1> " & G & " + 0.125*" & intRowIndex - 1 & " ,Height*1-(0.125*" & I & "),0)"
Set vsoRow = vsoShape.Section(visSectionConnectionPts).Row(intRowIndex)
vsoRow.Cell(visCnnctX).FormulaU = WString
vsoRow.Cell(visCnnctY).FormulaU = HString
vsoRow.Cell(visCnnctDirX).FormulaU = -1#
vsoRow.Cell(visCnnctDirY).FormulaU = 0#
vsoRow.Cell(visCnnctType).FormulaU = visCnnctTypeInward
Next I
ElseIf CL < N And (chk = 0 Or CL >= 1) Then
For I = CL + 1 To N
intRowIndex = vsoShape.AddRow(visSectionConnectionPts, visRowLast, visTagCnnctPt)
WString = "Width*0"
'Used for the Height Dimension of the connector to place the connection points
G = vsoShape.Cells("Scratch.X1").ResultIU
HString = "IF(Height*1> " & G & " + 0.125*" & intRowIndex - 1 & " ,Height*1-(0.125*" & I & "),0)"
Set vsoRow = vsoShape.Section(visSectionConnectionPts).Row(intRowIndex)
vsoRow.Cell(visCnnctX).FormulaU = WString
vsoRow.Cell(visCnnctY).FormulaU = HString
vsoRow.Cell(visCnnctDirX).FormulaU = -1#
vsoRow.Cell(visCnnctDirY).FormulaU = 0#
vsoRow.Cell(visCnnctType).FormulaU = visCnnctTypeInward
Next I
I believe my problem is with the implementation of the intRowIndex variable in both loops.
Actually, since I'm on vacation, I think the bigger issue is that I haven't drank enough local craft brews and I can't stop thinking about this stuff.
Ah! The curse of being an engineer. Not to worry, it will plague you even after you retire...I'm there. Not enough beer.
As an FYI, you can tile the Visio drawing window, shapesheet window and place the VBA window along side of both. Then, you can add a code breakpoint just before the suspected problematic code, and use F8 to step thru it line by line. With the window arrangement, you can see what the code does to both the shape and the shapesheet. Sometimes that helps with an "Oops! That's not what I want..."
Also, as you step thru the code, you can hover of variables and see what their current value is.
Oh, make sure the drawing window and not the shapesheet window is active. VBA will complain otherwise.
Your logic doesn't seem quite right...
If CR < N always adds connection points, but 3rd IF will always remove connection points. I get it that it's a rough description of the logic, but, as presented, would seem there must be some additional conditions to distinguish between adding and removing Connection points.
HTH
Wapperdude
Thanks for the feedback and help throughout this thread. I'll try the window arrangement when I get back to work where I have multiple monitors.
The third IF statement was a result of just a few more than necessary local crafts brews. Less than should have been greater than.
And yeah, I dreamed about this again last night. It's a sickness.
Multiple monitors not necessary...but stepping away can be helpful. Go do something totally different, and fun. Visio will survive! 😱 😁
Bah, why will this not work?
Case Is < CL, Is < CR
In other words,
Case is < CL OR Case is < CR
What am I missing here?
Should work...assuming everything is set correctly.
First 2 cases fail because I ententionally reversed the case condition signs.
Third case passes.
Sub test_case()
Dim MyNum As Integer
Dim aVal As Integer
Dim bVal As Integer
MyNum = 50
aVal = 25
bVal = 100
Select Case MyNum
Case Is < aVal
Debug.Print MyNum; "is greater than"; aVal
Case Is > 100
Debug.Print MyNum; "is less than"; vBal
Case Is < aVal, Is < bVal
Debug.Print "OK"
End Select
End Sub
Wapperdude
In my macro, it's ignoring the 2nd argument. For example, if I use
Case Is < CL, Is < CR
the code only checks for CL, and ignores CR.
If I use
Case Is < CR, Is < CL
the code checks for CR, and ignores CL.
Both CR and CL are integers, as is the variable tested against in the case statement.
Did you try the macro...as a sanity check?
As provided, 3rd case, 1st condition fails, 2nd condition passes, debug prints OK. This condition replicates your scenario. I have we V2007. But, nothing unique wrt this case structure.
Wapperdude
I went back to If statements and everything works great. No matter what I did, I could not get the case statement to test for the 2nd argument.
I posted the end result here (http://visguy.com/vgforum/index.php?topic=8419.0).
Thank you for all your help!