Author Topic: Add arrow to middle of connector?  (Read 55789 times)

0 Members and 1 Guest are viewing this topic.

JuneTheSecond

  • Hero Member
  • *****
  • Posts: 1027
    • Visio Shapes, Stencils and Sample Drawings
Re: Add arrow to middle of connector?
« Reply #15 on: July 12, 2010, 03:05:02 AM »
You need to move arrow on the connector back or forth, when connectors are crossing each other.
Here is adjustable arrow on connector.
Right click menu on a connector moves arrow back or forth, and resets to the center.
« Last Edit: July 12, 2010, 03:08:07 AM by JuneTheSecond »
Best Regards,

Junichi Yoda
http://june.minibird.jp/

JuneTheSecond

  • Hero Member
  • *****
  • Posts: 1027
    • Visio Shapes, Stencils and Sample Drawings
Re: Add arrow to middle of connector?
« Reply #16 on: July 13, 2010, 07:10:38 PM »
You might need more functionality, when one segment is too long.
You wish to move arrow on one segment back and forth.
Here added menues "Back on Segment", and so on.
« Last Edit: July 13, 2010, 09:57:40 PM by JuneTheSecond »
Best Regards,

Junichi Yoda
http://june.minibird.jp/

JuneTheSecond

  • Hero Member
  • *****
  • Posts: 1027
    • Visio Shapes, Stencils and Sample Drawings
Re: Add arrow to middle of connector?
« Reply #17 on: July 13, 2010, 11:23:07 PM »
If you need more quick access to arrow on connecotor,
please, enable VBA macro and press direct shortcut keys.
Best Regards,

Junichi Yoda
http://june.minibird.jp/

Jumpy

  • Hero Member
  • *****
  • Posts: 1061
Re: Add arrow to middle of connector?
« Reply #18 on: July 26, 2010, 08:50:54 AM »
Hello June,

very nice solution, that makes me rethink, what I have done in my solution. Maybe I generate sth. new of both ways, when there's time, because I'm not satisfied with the current version.

I used a filled triangle shape (my "arrowhead"), which calls a makro on drop, to see, if the arrow is placed on a certain type of connector ("Leitung"). It then turns the arrowhead in the right direction and places it in the centre of the connector segment it was droped on. It is still a separate shape, so when moving the connector the arrowhead stays behind. Therefore it is only used in the final stages of a drawing, when the layout is complete. The reason, why I stay with an extra shape (not grouped to the connector) is that I can move the shape slightly afterwards if neccessary and align it with a arrowhead on a connector that runs parallel(?alongside?) the first connector. Also I can place more than one arrowhead on the same path segment (if it's a long one that may become neccessary).

Here's the code I use for this. Maybe someone gets an idea:
Code
Public Sub Pfeil_Drop(dropee As Visio.Shape)
'*********************************************************
'* Drop Makro für Arrow-Heads                            *
'* Startet from Callthis-Fkt. in Arrowhead-Shape         *
'* Makro only tests, if arrowhead is droped on connector *
'* ("Leitung"). If yes is starts a further makro         *
'*********************************************************
Dim shp As Visio.Shape
On Error Resume Next
For Each shp In ActivePage.Shapes
 If shp.DistanceFrom(dropee, 0) <= 0 And shp <> dropee Then         'Hit
  If shp.CellExists("User.Typ", False) Then
   If shp.Cells("User.Typ").ResultStr(0) = "Leitung" Then
    Pfeil_Leitung dropee, shp
    Exit Sub
   End If
  End If
 End If
Next

End Sub

Public Sub Pfeil_Leitung(ByVal Pfeil As Visio.Shape, ByVal Leitung As Visio.Shape, Optional Range As Integer = 2)
'******************************************************
'* Makro for arrowhead placement on connector segment *
'* Startet from Makro Pfeil_Drop                      *
'******************************************************

Dim vsoShape As Visio.Shape
Dim adblXYPoints() As Double
Dim strPointsList As String
Dim intOuterLoopCounter As Integer
Dim intInnerLoopCounter, Pfadsegment, Segmentanzahl, a, b, i As Integer
Dim X(50), Y(50), PX, PY As Double

Pfadsegment = 0
PX = Pfeil.Cells("PinX").Result("MM")
PY = Pfeil.Cells("PinY").Result("MM")

'Here the points along the path are sored in X(i)/Y(i) Variables
'---------------------------------------------------------------------------------------
    Set vsoShape = Leitung
    For intOuterLoopCounter = 1 To vsoShape.Paths.Count

        vsoShape.Paths(intOuterLoopCounter).Points 0.5, adblXYPoints
        a = 1
        b = 1
        For intInnerLoopCounter = LBound(adblXYPoints) To UBound(adblXYPoints)
            If a Mod 2 = 1 Then
             X(b) = (adblXYPoints(intInnerLoopCounter) * 25.4)
            Else
             Y(b) = (adblXYPoints(intInnerLoopCounter) * 25.4)
             b = b + 1
            End If
            strPointsList = strPointsList & a & ": " & (adblXYPoints(intInnerLoopCounter) * 25.4) & Chr(10)
            a = a + 1
        Next intInnerLoopCounter
    If Trim(X(1)) = Trim(Leitung.Cells("BeginX").Result("MM")) And Trim(Y(1)) = Trim(Leitung.Cells("BeginY").Result("MM")) Then
     intOuterLoopCounter = vsoShape.Paths.Count
    End If
    Next intOuterLoopCounter
       
Segmentanzahl = b - 2
'---------------------------------------------------------------------------------------


'Now analyse, on witch segment of the connector the arrowhead was droped
'---------------------------------------------------------------------------------------
For i = 1 To Segmentanzahl
If X(i + 1) - X(i) = 0 Then                        'vertical Segment
 If PX > X(i) - Range And PX < X(i) + Range Then   'Test if arrowhead on X coordinate
  If Y(i + 1) - Y(i) > 0 Then                      'Direction "up"
   If PY < Y(i + 1) And PY > Y(i) Then             'arrowhead in Y Intervall
    Pfadsegment = i
    i = Segmentanzahl
   End If
  ElseIf Y(i + 1) - Y(i) < 0 Then                  'Direction "down"
   If PY > Y(i + 1) And PY < Y(i) Then             'arrowhead in Y Intervall
    Pfadsegment = i
    i = Segmentanzahl
   End If
  Else
  'Nix tun
  End If
 End If
ElseIf Y(i + 1) - Y(i) = 0 Then                    'horizontal Segment
 If PY > Y(i) - Range And PY < Y(i) + Range Then   'Test if arrowhead on Y coordinate
  If X(i + 1) - X(i) > 0 Then                      'Direction "right"
   If PX < X(i + 1) And PX > X(i) Then             'arrowhead in X Intervall
    Pfadsegment = i
    i = Segmentanzahl
   End If
  ElseIf X(i + 1) - X(i) < 0 Then                  'Direction "left"
   If PX > X(i + 1) And PX < X(i) Then             'arrowhead in X Intervall
    Pfadsegment = i
    i = Segmentanzahl
   End If
  Else
  'Nix tun
  End If
 End If
Else                                       'Diagonales Segment
'is ignored, but could be captured
End If
Next i
'---------------------------------------------------------------------------------------

'Now place arrowhead in the middle of the Pathsegment (in the right direction)
'---------------------------------------------------------------------------------------
If Pfadsegment = 0 Then Exit Sub '...oder auch nicht ;-)

If X(Pfadsegment) - X(Pfadsegment + 1) = 0 Then     'vertical Segment
 Pfeil.Cells("PinX").Result("MM") = X(Pfadsegment)
  Pfeil.Cells("PinY").Result("MM") = Y(Pfadsegment) + (Y(Pfadsegment + 1) - Y(Pfadsegment)) / 2
  If Y(Pfadsegment + 1) - Y(Pfadsegment) > 0 Then   'up
   Pfeil.Cells("Angle").Result("deg") = 0
  Else                                              'down
   Pfeil.Cells("Angle").Result("deg") = 180
  End If
Else                                                'horizontal Segment
 Pfeil.Cells("PinY").Result("MM") = Y(Pfadsegment)
  Pfeil.Cells("PinX").Result("MM") = X(Pfadsegment) + (X(Pfadsegment + 1) - X(Pfadsegment)) / 2
  If X(Pfadsegment + 1) - X(Pfadsegment) > 0 Then   'right
   Pfeil.Cells("Angle").Result("deg") = -90
  Else                                              'left
   Pfeil.Cells("Angle").Result("deg") = 90
  End If
End If

'Give it the right color based on temperature (interesting only for my solution)
Pfeil.Cells("Prop.Temperatur").Result("") = Leitung.Cells("Prop.Temperatur").Result("")

'---------------------------------------------------------------------------------------

End Sub