zOOM TO SELECTION FOR TO THE NODES SELECTION - FEATURE REQUEST

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

'2018-08-04
Option Explicit

Sub JQ_Zoom_to_Selected_Nodes()

Const strmacroname = "JQ Zoom to Selected Nodes"
Dim sr As ShapeRange
Dim srCurvesSel As ShapeRange
Dim s As Shape
Dim dblAllXMin As Double
Dim dblAllXMax As Double
Dim dblAllYMin As Double
Dim dblAllYMax As Double
Dim dblAllWidth As Double
Dim dblAllHeight As Double
Dim dblCrvXMin As Double
Dim dblCrvXMax As Double
Dim dblCrvYMin As Double
Dim dblCrvYMax As Double
Dim dblViewXMin As Double
Dim dblViewXMax As Double
Dim dblViewYMin As Double
Dim dblViewYMax As Double
Dim noderangeThis As NodeRange
Dim blnFoundNodesSelected As Boolean
Dim dblMinViewSizeDocUnits As Double

''''''''''''''''''''''''''''''''''''''''''''''''''''
'This sets the minimum view size in 1/10 micrometers.
Const dblMinViewSizeTenthMicrons As Double = 500000
'This sets the "padding" of the view area as a percentage of the dimensions
'of the area that contains the selected nodes.
Const dblPadPercentage As Double = 20
''''''''''''''''''''''''''''''''''''''''''''''''''''

    On Error GoTo ErrHandler
    
    If ActiveDocument Is Nothing Then
        MsgBox "No document is active.", vbInformation, strmacroname
        GoTo ExitSub
    Else
        Set sr = ActiveSelectionRange
        Set srCurvesSel = sr.Shapes.FindShapes(, cdrCurveShape, False)
        If srCurvesSel.Count = 0 Then
            MsgBox "No Curves are selected.", vbInformation, strmacroname
            GoTo ExitSub
        End If
    End If
    
    For Each s In srCurvesSel
        Set noderangeThis = s.Curve.Selection
        With noderangeThis
            If .Count > 0 Then
                If blnFoundNodesSelected Then
                    dblCrvXMin = .PositionX
                    dblCrvXMax = .PositionX + .SizeWidth
                    dblCrvYMax = .PositionY
                    dblCrvYMin = .PositionY - .SizeHeight
                    
                    If dblCrvXMin < dblAllXMin Then
                        dblAllXMin = dblCrvXMin
                    End If
                    
                    If dblCrvXMax > dblAllXMax Then
                        dblAllXMax = dblCrvXMax
                    End If
                    
                    If dblCrvYMin < dblAllYMin Then
                        dblAllYMin = dblCrvYMin
                    End If
                    
                    If dblCrvYMax > dblAllYMax Then
                        dblAllYMax = dblCrvYMax
                    End If
                    
                Else
                    dblAllXMin = .PositionX
                    dblAllXMax = .PositionX + .SizeWidth
                    dblAllYMax = .PositionY
                    dblAllYMin = .PositionY - .SizeHeight
                    blnFoundNodesSelected = True
                End If
            End If
        End With
    Next s

    If blnFoundNodesSelected Then
        dblMinViewSizeDocUnits = ActiveDocument.ToUnits(dblMinViewSizeTenthMicrons, cdrTenthMicron)
        
        dblAllWidth = dblAllXMax - dblAllXMin
        If dblAllWidth > dblMinViewSizeDocUnits Then
            dblViewXMin = dblAllXMin - dblPadPercentage / 100 * dblAllWidth
            dblViewXMax = dblAllXMax + dblPadPercentage / 100 * dblAllWidth
        Else
            dblViewXMin = dblAllXMin - (dblMinViewSizeDocUnits - dblAllWidth) / 2 - dblPadPercentage / 100 * dblAllWidth
            dblViewXMax = dblAllXMax + (dblMinViewSizeDocUnits - dblAllWidth) / 2 + dblPadPercentage / 100 * dblAllWidth
        End If
        
        dblAllHeight = dblAllYMax - dblAllYMin
        If dblAllHeight > dblMinViewSizeDocUnits Then
            dblViewYMin = dblAllYMin - dblPadPercentage / 100 * dblAllHeight
            dblViewYMax = dblAllYMax + dblPadPercentage / 100 * dblAllHeight
        Else
            dblViewYMin = dblAllYMin - (dblMinViewSizeDocUnits - dblAllHeight) / 2 - dblPadPercentage / 100 * dblAllHeight
            dblViewYMax = dblAllYMax + (dblMinViewSizeDocUnits - dblAllHeight) / 2 + dblPadPercentage / 100 * dblAllHeight
        End If
            
        ActiveWindow.ActiveView.ToFitArea dblViewXMin, dblViewYMax, dblViewXMax, dblViewYMin
    Else
        MsgBox "No nodes are selected in the selected Curves.", vbInformation, strmacroname
    End If

ExitSub:
    Exit Sub

ErrHandler:
    MsgBox "Error occurred: " & Err.Description & vbCrLf & vbCrLf & "JQ_Zoom_to_Selected_Nodes()"
    Resume ExitSub
End Sub