Get the IDs of shapes of offset operation

Started by Yacine, October 13, 2014, 04:45:16 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Yacine

Hi Guys,
would someone know how to get the IDs of the shapes created when doing an offset operation on a shape?
Yacine

Paul Herber

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.
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

JuneTheSecond

How would you like iterate in window.selection?
Best Regards,

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

Yacine

#3
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).
Yacine

JuneTheSecond

Not select all, but selection just after offset.
Best Regards,

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

Yacine

Hi Junichi-san,
I tried this. It gets only the last of two created shapes.
Yacine

JuneTheSecond

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.
Best Regards,

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

Yacine

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

JuneTheSecond

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

Best Regards,

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

Croc

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


JuneTheSecond

Best Regards,

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

Yacine

#11
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!
Yacine