Hi Guys,
would someone know how to get the IDs of the shapes created when doing an offset operation on a shape?
Hi Yacine, don't know if there is a correct way to do the job, but ...
1. get the current page shape count (say, n)
2. do the offset operation
3. the new shapes have IDs n+1, n+2 etc for however many shapes have been created
If any one of the shapes are grouped then many new shapes may be created.
How would you like iterate in window.selection?
Thank you guys,
this was also my first thought. Compare a select all selection before and after the offset.
But I thought, this may take to much time.
Another approach could be to catch the shape created event. Here the difficulty lays in the event sink, that is required because I want to implement the solution in a stencil (That's something that I could not get yet to work).
I'll sleep a night over it. Thanks again.
PS: ID+N and N+1 mustn't work, if there'S a gap in the ID list (deleted shape).
Not select all, but selection just after offset.
Hi Junichi-san,
I tried this. It gets only the last of two created shapes.
You are right. I forgot it.
Though it is not your spec, if selected shapes are offset with macro, the IDs of created shapes can be obtained, I think, as you mentioned.
I found a work around.
Namely to put the desired shape in a group, open the group window and do all the necessary operations in that window.
This is not just an exercise for me, but the enclosed code snippet may inspire you to do more out of it.
Sub setOffset()
Dim shp As Shape
Dim off1 As Shape, off2 As Shape
Dim Grp As Shape, newGrp As Shape
Dim lin1 As Shape, lin2 As Shape
Set shp = ActiveWindow.Selection(1)
ActiveWindow.DeselectAll
ActiveWindow.Select shp, visSelect
Set Grp = ActiveWindow.Selection.Group 'put the selected connector in a group
Grp.OpenDrawWindow.Activate 'open the group in a new window
ActiveWindow.Select shp, visSelect 'select the shape to offset
Application.ActiveWindow.Selection.Offset 0.07874 'offset
ActiveWindow.SelectAll
ActiveWindow.Select shp, visDeselect
Set off1 = ActiveWindow.Selection(1)
Set off2 = ActiveWindow.Selection(2)
off1.AddRow visSectionConnectionPts, visRowLast, visTagDefault
off1.CellsSRC(visSectionConnectionPts, 0, visCnnctX).FormulaForceU = "=geometry1.X1"
off1.CellsSRC(visSectionConnectionPts, 0, visCnnctY).FormulaForceU = "=geometry1.Y1"
'Last row
n = off1.RowCount(visSectionFirstComponent) - 1
off1.AddRow visSectionConnectionPts, 1, visTagDefault
off1.CellsSRC(visSectionConnectionPts, 1, visCnnctX).FormulaForceU = "=geometry1.X" & n
off1.CellsSRC(visSectionConnectionPts, 1, visCnnctY).FormulaForceU = "=geometry1.Y" & n
off2.AddRow visSectionConnectionPts, visRowLast, visTagDefault
off2.CellsSRC(visSectionConnectionPts, 0, visCnnctX).FormulaForceU = "=geometry1.X1"
off2.CellsSRC(visSectionConnectionPts, 0, visCnnctY).FormulaForceU = "=geometry1.Y1"
'Last row
n = off2.RowCount(visSectionFirstComponent) - 1
off2.AddRow visSectionConnectionPts, 1, visTagDefault
off2.CellsSRC(visSectionConnectionPts, 1, visCnnctX).FormulaForceU = "=geometry1.X" & n
off2.CellsSRC(visSectionConnectionPts, 1, visCnnctY).FormulaForceU = "=geometry1.Y" & n
Set lin1 = Application.ActiveWindow.Shape.DrawLine(1, 1, 2, 2)
Dim vsoCell1 As Visio.Cell
Dim vsoCell2 As Visio.Cell
Set vsoCell1 = lin1.CellsU("BeginX")
Set vsoCell2 = off1.CellsSRC(7, 0, 0)
vsoCell1.GlueTo vsoCell2
Set vsoCell1 = lin1.CellsU("EndX")
Set vsoCell2 = off2.CellsSRC(7, 0, 0)
vsoCell1.GlueTo vsoCell2
Set lin2 = Application.ActiveWindow.Shape.DrawLine(1, 1, 2, 2)
Set vsoCell1 = lin2.CellsU("BeginX")
Set vsoCell2 = off1.CellsSRC(7, 1, 0)
vsoCell1.GlueTo vsoCell2
Set vsoCell1 = lin2.CellsU("EndX")
Set vsoCell2 = off2.CellsSRC(7, 1, 1)
vsoCell1.GlueTo vsoCell2
ActiveWindow.DeselectAll
ActiveWindow.Select off1, visSelect
ActiveWindow.Select off2, visSelect
ActiveWindow.Select lin1, visSelect
ActiveWindow.Select lin2, visSelect
ActiveWindow.Selection.Join
ActiveWindow.SelectAll
ActiveWindow.Select shp, visDeselect
Set newGrp = ActiveWindow.Selection(1)
newGrp.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "rgb(255,255,250)"
Application.ActiveWindow.Close
ActiveWindow.Select Grp, visSelect
ActiveWindow.Selection.Ungroup
ActiveWindow.Selection.DeselectAll
ActiveWindow.Select shp, visSelect
End Sub
Yacine's solution let me try a simple macro that offset selected shapes by 5mm and colors red.
In Module1.
Option Explicit
Public IDScope As Long
Sub OffsetSelection()
IDScope = Application.BeginUndoScope("pgmOffcet")
ActiveWindow.Selection.Offset 5 / 25.4
Application.EndUndoScope IDScope, True
End Sub
And in module ThisDocument.
Option Explicit
Private Sub Document_ShapeAdded(ByVal Shape As IVShape)
If Application.IsInScope(IDScope) Then
Shape.Cells("LineColor").FormulaForce = visRed
Debug.Print Shape.ID
End If
End Sub
Maybe WithEvents will better?
Dim WithEvents tmpDoc As Visio.Document
Sub OffsetSelection()
Set tmpDoc = ActiveDocument
ActiveWindow.Selection.Offset 5 / 25.4
Set tmpDoc = Nothing
End Sub
Private Sub tmpDoc_ShapeAdded(ByVal Shape As IVShape)
Shape.Cells("LineColor").FormulaForce = visRed
Debug.Print Shape.ID
End Sub
Elegant!
Since you are already messing with the document itself (I wanted to avoid this, because I want to set this solution in a stencil),
then yes that is an acceptable solution.
Thanks.
And I agree with Junichi: elegant!