Alignment of positions(balloons) to first selected position

Because Autodesk erase function for alignment positions (balloons) to first fixed selected position and this function missing me, I made a macro for this function. I put the macro here for those who wants. It is with czech notes(green).

Public Sub ZarovnaniPozic()
 Dim tentoDokument As DrawingDocument
 Set tentoDokument = ThisApplication.ActiveDocument
 If tentoDokument.SelectSet.Count < 2 Then
  MsgBox ("Předem musí být vybrané pozice. Aspoň dvě.")
  End
 End If
 If tentoDokument.SelectSet.Item(1).Type <> kBalloonObject Then
  MsgBox ("První vybraná musí být pozice.")
  End
 End If
 Dim RoztecVertikalni As Double
 Dim RoztecHorizontalni As Double
 RoztecVertikalni = tentoDokument.SelectSet.Item(1).Style.DefaultOffset / 0.45652   'Pevná hodnota 2.3
 RoztecHorizontalni = tentoDokument.SelectSet.Item(1).Style.DefaultOffset / 0.33333 'Pevná hodnota 3.15
 Dim VykresovaGeometrie As TransientGeometry
 Set VykresovaGeometrie = ThisApplication.TransientGeometry
 Dim PrvniPozice As Balloon
 Set PrvniPozice = tentoDokument.SelectSet.Item(1)             'První zadaná pozice - výchozí
 Dim PocetPozic As Integer
 PocetPozic = 0
 Dim Vybrabne As Variant
 For Each Vybrabne In tentoDokument.SelectSet                  'Filtrace pozic od jiných věcí a zjištění počtu
  If Vybrabne.Type = kBalloonObject Then
   PocetPozic = PocetPozic + 1
  End If
 Next
 Dim Smer As Integer
 Dim SeznamPozic() As Balloon
 Dim PosunutiPozice() As Double
 ReDim SeznamPozic(PocetPozic - 1)
 ReDim PosunutiPozice(PocetPozic - 1)
 Dim SouradnicePozice As Point2d
 Dim Posunuti As Double
 Dim a As Double                'koeficient více pozic
 Dim i As Integer
 Dim j As Integer
 i = 0
 For Each Vybrabne In tentoDokument.SelectSet                 'Načtení seznamu
  If Vybrabne.Type = kBalloonObject Then
   Set SeznamPozic(i) = Vybrabne
   i = i + 1
  End If
 Next

 'Zjistit orientaci horizontálně nebo vertikálně
 Dim PosunutiX As Double
 Dim PosunutiY As Double
 Dim Orientace As Boolean
 Orientace = True                                              'VERTIKALNĚ
 PosunutiX = Abs(PrvniPozice.Position.X - SeznamPozic(PocetPozic - 1).Position.X) / RoztecHorizontalni
 PosunutiY = Abs(PrvniPozice.Position.Y - SeznamPozic(PocetPozic - 1).Position.Y) / RoztecVertikalni
 If PosunutiX > PosunutiY Then
  Orientace = False                                            'HORIZONTALNĚ
 End If
                                                  'Zjištění kam co posunout
 For i = 0 To (PocetPozic - 1)
  Posunuti = 0
  If Orientace Then                                               'VERTIKALNĚ
   a = 1
   If PrvniPozice.Position.Y > SeznamPozic(i).Position.Y Then
    Smer = -1 'Dolů
   Else
    Smer = 1 'Nahoru
   End If
   For j = 0 To (PocetPozic - 1)           'Zjištění kam posunout
    If SeznamPozic(i).Position.Y = PrvniPozice.Position.Y Then
     Posunuti = 0
    ElseIf Smer = 1 And SeznamPozic(i).Position.Y > SeznamPozic(j).Position.Y And SeznamPozic(j).Position.Y >= PrvniPozice.Position.Y Then  'nahoru
     Posunuti = Posunuti + 1
     If SeznamPozic(j).BalloonValueSets.Count > 1 And SeznamPozic(j).PlacementDirection = kBottomDirection And j > 0 Then
      Posunuti = Posunuti + a * (SeznamPozic(j).BalloonValueSets.Count - 1) 'navíc pro vícepozicovou pozici
     End If
    ElseIf Smer = -1 And SeznamPozic(i).Position.Y < SeznamPozic(j).Position.Y And SeznamPozic(j).Position.Y <= PrvniPozice.Position.Y Then 'dolu
      Posunuti = Posunuti + 1
      If SeznamPozic(j).BalloonValueSets.Count > 1 And SeznamPozic(j).PlacementDirection = kBottomDirection Then
       Posunuti = Posunuti + a * (SeznamPozic(j).BalloonValueSets.Count - 1) 'navíc pro vícepozicovou pozici
      End If
    End If
   Next
   If SeznamPozic(i).BalloonValueSets.Count > 1 And SeznamPozic(i).PlacementDirection = kBottomDirection And i > 0 And Smer = 1 Then
    Posunuti = Posunuti + a * (SeznamPozic(i).BalloonValueSets.Count - 1) 'navíc pro vícepozicovou pozici
   End If
   PosunutiPozice(i) = PrvniPozice.Position.Y + Smer * (RoztecVertikalni * Posunuti)
  Else                                                                               'HORIZONTALNĚ
   a = 0.7
   If PrvniPozice.Position.X > SeznamPozic(i).Position.X Then
    Smer = -1 'Vlevo
   Else
    Smer = 1  'Vpravo
   End If
   For j = 0 To (PocetPozic - 1)           'Zjištění kam posunout
    If SeznamPozic(i).Position.X = PrvniPozice.Position.X Then
     Posunuti = 0
    ElseIf Smer = 1 And SeznamPozic(i).Position.X > SeznamPozic(j).Position.X And SeznamPozic(j).Position.X >= PrvniPozice.Position.X Then
     Posunuti = Posunuti + 1
     If SeznamPozic(j).BalloonValueSets.Count > 1 And SeznamPozic(j).PlacementDirection = kRightDirection Then
      Posunuti = Posunuti + a * (SeznamPozic(j).BalloonValueSets.Count - 1) 'navíc pro vícepozicovou pozici
     End If
    ElseIf Smer = -1 And SeznamPozic(i).Position.X < SeznamPozic(j).Position.X And SeznamPozic(j).Position.X <= PrvniPozice.Position.X Then
      Posunuti = Posunuti + 1
     If SeznamPozic(j).BalloonValueSets.Count > 1 And SeznamPozic(j).PlacementDirection = kLeftDirection Then
      Posunuti = Posunuti + a * (SeznamPozic(j).BalloonValueSets.Count - 1) 'navíc pro vícepozicovou pozici
     End If
    End If
   Next
   If SeznamPozic(i).BalloonValueSets.Count > 1 And i > 0 Then      'navíc pro vícepozicovou pozici
    Select Case Smer
     Case 1
      If SeznamPozic(i).PlacementDirection = kLeftDirection Then
       Posunuti = Posunuti + a * (SeznamPozic(i).BalloonValueSets.Count - 1)
      End If
     Case -1
      If SeznamPozic(i).PlacementDirection = kRightDirection Then
       Posunuti = Posunuti + a * (SeznamPozic(i).BalloonValueSets.Count)
      End If
    End Select
   End If
   PosunutiPozice(i) = PrvniPozice.Position.X + Smer * (RoztecHorizontalni * Posunuti)
  End If
 Next
                                         'Posunutí kažné pozice
 For i = 0 To (PocetPozic - 1)
  If Orientace Then
   SeznamPozic(i).Position = VykresovaGeometrie.CreatePoint2d(PrvniPozice.Position.X, PosunutiPozice(i))
  Else
   SeznamPozic(i).Position = VykresovaGeometrie.CreatePoint2d(PosunutiPozice(i), PrvniPozice.Position.Y)
  End If
 Next
End Sub