Выстроить фигуры, чтобы иметь совпадающие края Visio VBA - PullRequest
Новая
       57

Выстроить фигуры, чтобы иметь совпадающие края Visio VBA

0 голосов
/ 27 марта 2020

В прошлом я использовал VBA в основном с Excel, но я не очень опытен.

Я хочу перебрать несколько блоков и сделать так, чтобы у каждого из них были совпадающие ребра. Как будто они сидят друг на друге. У меня проблемы с определением позиции первой фигуры в моем выборе. Я пробовал несколько различных объектов, включая selection.shaperange. 

    Dim shp As Visio.Shape
    Dim shp1 As Visio.Shape
    Dim Pos As Double
    Set shp1 = ActiveWindow.Selection.ShapeRange.Item
    Pos = shp1.Cells("PinY")

    For Each shp In Application.ActiveWindow.Selection
            'Change the cell name to the one you want
        If shp <> ActiveWindow.Selection.Item(1) Then
            Pos = Pos + 6
        End If

        shp.CellsSRC(visSectionControls, visRowXFormOut, visXFormPinY).FormulaU = Pos & "mm"
        Pos = shp.Cells("PinY")
    Next shp
End Sub

Можете ли вы помочь мне определить положение первого выбранного элемента, а затем я смогу выяснить остальные.

1 Ответ

0 голосов
/ 06 апреля 2020

Этот код примыкает к левым сторонам всех фигур, кроме первой выбранной, с правой стороной первой выбранной формы: 

Option Explicit

Public Sub AbutLeftsToPrimaryRight()

  Dim sel As Visio.Selection
  Set sel = Visio.ActiveWindow.Selection

  If (sel.Count < 2) Then
    Debug.Print "Select two or more shapes (Use Shift + Click)!"
    GoTo Cleanup
  End If

  Dim shp0 As Visio.Shape
  Dim shp As Visio.Shape

  '// Get the selection and the primary selected shape,
  '// which is item(1). See also: Selection.PrimaryItem
  Set shp0 = sel(1)

  '// Quick calculate the right side of shp0:
  '// PinX - LocPinX + Width.
  Dim dRight0 As Double
  dRight0 = shp0.CellsU("PinX").ResultIU - shp0.CellsU("LocPinX").ResultIU + shp0.CellsU("Width").ResultIU

  '// If shapes are rotated, flipped, or not rectangular,
  '// then you'll need to use shp.BoundingBox, which
  '// is more complicated

  Dim dLeft As Double
  Dim dx As Double, px As Double
  Dim i As Integer
  For i = 2 To sel.Count

    '// Get the ith shape:
    Set shp = sel(i)

    '// Get its Pin:
    px = shp.CellsU("PinX").ResultIU

    '// Calculate the left side of the shape:
    '// PinX - LocPinX:
    dLeft = px - shp.CellsU("LocPinX").ResultIU

    '// The offset:
    dx = dLeft - dRight0

    '// Set the new pin:
    shp.CellsU("PinX").ResultIUForce = px - dx

  Next i

Cleanup:
  Set shp0 = Nothing
  Set shp = Nothing
  Set sel = Nothing
End Sub

Надеюсь, это поможет!

...