Changing layer membership in VBA

Started by Pat_43, July 31, 2019, 12:40:52 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Pat_43

I've been playing with this for a while and can't get my head around why it won't work..

Bear in mind I'm fairly novice when it comes to VBA mostly taking code examples and adjusting them for what I want it to do.

I'm trying to highlight incoming and outgoing connectors to a shape but also pull the highlighted connectors from a non-visible layer to a visible one. The code I have at the moment (found in an old thread on this forum I think) looks like this:



        selShp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = selClr 'Highlight selected shape
        For i = 1 To selShp.FromConnects.Count                              'Get the connected "from" shapes, i.e., what is glued to the selected shape.
            Set FromConShp = selShp.FromConnects(i).FromSheet               'This is connector glued to the selected shape.
           
            FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3;6"""          'Copy selected layer 3 connectors to 3 and 6
            FromConShp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = HiClr                           'Highlight connectors
            Application.ActiveWindow.Selection.BringToFront

            For Each conObj In FromConShp.Connects                          'Find shape connected to opposite connector end
                Set ToConShp = conObj.ToSheet                               'This is the opposite end shape, that the from shape is attacthed to.
                If ToConShp <> selShp Then                                  'Skip selected shape; already colored.
                    ToConShp.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = DestClr
                End If
            Next conObj
        Next i
   


The issue I have is that this will select all connectors to the shape (currently on layers 2 and 3) and move them to layers 3 and 6, what I want is to be able to select only the connectors on layer 3 and move them to layers 3 and 6. I've tried using an if statement on these lines but get an invalid property on the FormulaU part of the code.


If FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3""" Then
Set FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3;6"""


Is it possible to just select connectors to the shape on a certain layer?

Further complication... Once I've got this sorted I also want to differentiate between the incoming and outgoing connectors. I've tried using GluedShapes (visGluedShapesIncoming1D, " ") instead of the FromConnects but it comes up as an invalid qualifier and I'm not sure why. If I can get these to work correctly I'm confident I can edit enough to have different highlights for incoming and outgoing connectors.

Thanks

wapperdude

Regarding connectivity, incoming/outgoing connections, see:  http://visguy.com/vgforum/index.php?topic=8701.msg38015#msg38015

For layer membership, you need to add IF condition to the shape to see if the desired layer is layer is visible or not.  See reply number 2 of this post to help search for layer by name:  http://visguy.com/vgforum/index.php?topic=8635.msg37650#msg37650

These ought to help.
Visio 2019 Pro

Pat_43

Thanks Wapperdude

The layer setting has worked perfectly, I've now got:



         If FromConShp.CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU = """3""" Then       
         Set vsoLayer1 = ActivePage.Layers.Item("Connector")
         vsoLayer1.Add FromConShp, 1
         End If


Which does exactly what I want in pulling items only from layer 3 to the connector layer while maintaining membership  of layer 3.

Time to get my head around the connectivity now.

Pat_43

Sorted.

It all seems so simple now:



Dim shpIDs() As Long
Dim SelShp As Visio.Shape

    shpIDs = SelShp.GluedShapes(visGluedShapesIncoming1D, "")                   ' Highlight incoming connectors
    For i = 0 To UBound(shpIDs)
         ActivePage.Shapes.ItemFromID(shpIDs(i)).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = InClr
       
    Next

    shpIDs = SelShp.GluedShapes(visGluedShapesOutgoing1D, "")                   ' Highlight outgoing connectors
    For i = 0 To UBound(shpIDs)
         ActivePage.Shapes.ItemFromID(shpIDs(i)).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = OutClr
               
    Next


OldSchool1948

This works for me:

Public Sub setShapeOnLayer( _
                vsoPage As Visio.Page, _
                vsoshape As Visio.Shape, _
                strLayerName As String)

    Dim vsoLayer As Visio.Layer

    If isLayer( _
        strLayerName, _
        vsoPage) = False Then
       
        Call vsoPage.Layers.Add(strLayerName)
   
    End If
   
    Set vsoLayer = vsoPage.Layers(strLayerName)

    '// Remove from any existing layer
    vsoshape.CellsSRC(visSectionObject, visRowLayerMem, _
    visLayerMember).FormulaForceU = """"""

    '// Add shape to layer
    vsoLayer.Add vsoshape, 0
       
End Sub


Public Function isLayer( _
                    strThisLayer As String, _
                    vsoPage As Visio.Page) As Boolean

    On Error Resume Next
   
    Dim vsoLayer As Visio.Layer
    Set vsoLayer = vsoPage.Layers(strThisLayer)
   
    On Error GoTo 0
   
    isLayer = IIf(vsoLayer Is Nothing, False, True)
   
End Function