SIR,
When nodes are selected and wanted to zoom to that selection is easier
if provided this to zoom to selection for nodes as well
regards
sriram
Thank you so much ... eskimo sir
Sub Zoom2FitNodes()Dim x#, y#, w#, h#, u% If ActiveShape Is Nothing Then Exit Sub u = ActiveDocument.Unit: ActiveDocument.Unit = cdrMillimeter With ActiveShape If .Type <> cdrCurveShape Then Exit Sub If .Curve.Selection.Count > 1 Then .Curve.Selection.GetBoundingBox x, y, w, h ActiveWindow.ActiveView.ToFitArea x - 2, y - 2, x + w + 2, y + h + 2 End If End With ActiveDocument.Unit = uEnd Sub
P.S. dont know what tag use, #code, /code or something like it...
Superrrrrr sir Shark Sir. Just Thanking you so much sir
Here is a "Zoom to Selected Nodes" macro that I wrote:
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
.
The code above was revised on 2018-08-04 after I found some errors. For selection areas smaller than the minimum view size, I was not applying the "padding". If a selection were just slightly smaller than the minimum view size, then the zoom would give it almost no padding.
If it's content that can be accessed by the general public, and can be found through a regular Google search, then I would just post a link to it.