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

Presentation of my macro for assembly drawings

Autodesk Inventor macro for Print all drawings

Here is my macro for print all drawings for components for opened drawing. The condition is the same name model and drawing. But this condition can be changed. I tested the macro only on Inventor version 2016.

Function TiskVykresu(CestaVykresu As String, Zavrit As Boolean)
 'Funkce pro tisk výkresu podle jeho velikosti
 Dim oDrgDoc As Inventor.Document
 Dim JmenoDokumentu As String
 ThisApplication.SilentOperation = True
 Set oDrgDoc = ThisApplication.Documents.Open(CestaVykresu)
 JmenoDokumentu = oDrgDoc.DisplayName
 Dim oDrgPrintMgr As DrawingPrintManager
 Set oDrgPrintMgr = oDrgDoc.PrintManager
 Dim JmenoAktualnihoListu As String
 Dim JmenaListu As String
 Dim PocetListu As Long
 PocetListu = oDrgDoc.Sheets.Count
 'Zjištění velikosti aktivního listu
 Dim VelikostListu As String
 Dim VelikostTisku As String
 oDrgPrintMgr.Printer = "\\VFS01\prt_16_chodba_prizemi_primy" 'Nastavit podle svojí tiskárny
 oDrgPrintMgr.PaperSize = kPaperSizeA3 'Přednastavení
 VelikostTisku = "A3" 'Přednastavení
 oDrgPrintMgr.AllColorsAsBlack = True

 oDrgPrintMgr.NumberOfCopies = 1

 oDrgPrintMgr.PrintRange = kPrintAllSheets
 oDrgPrintMgr.Orientation = kPortraitOrientation
 Select Case oDrgDoc.Sheets.Item(1).Size
  Case kA0DrawingSheetSize
   VelikostListu = "A0"
   oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA1DrawingSheetSize
   VelikostListu = "A1"
   oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA2DrawingSheetSize
   VelikostListu = "A2"
   oDrgPrintMgr.ScaleMode = kPrintBestFitScale
  Case kA3DrawingSheetSize
   VelikostListu = "A3"
   oDrgPrintMgr.PaperSize = kPaperSizeA3 'Nastavení papíru tiskárny
   VelikostTisku = "A3"
   oDrgPrintMgr.ScaleMode = kPrintFullScale
  Case kA4DrawingSheetSize
   VelikostListu = "A4"
   oDrgPrintMgr.PaperSize = kPaperSizeA4 'Nastavení papíru tiskárny
   VelikostTisku = "A4"
   oDrgPrintMgr.ScaleMode = kPrintFullScale
  Case Else
   VelikostListu = "nestandartní"
 End Select
 ' Zjištění natočení listu a případná změna
 Dim OtoceniListu As String
 If oDrgDoc.ActiveSheet.Orientation = kPortraitPageOrientation Then
  oDrgPrintMgr.Rotate90Degrees = 0
  OtoceniListu = "na výšku"
 Else
  oDrgPrintMgr.Rotate90Degrees = 1
  OtoceniListu = "na šířku"
 End If
 JmenoAktualnihoListu = oDrgDoc.ActiveSheet.Name
 Dim CisloAktivnihoListu As Long
 Dim i As Variant
 'Zjištění čísla aktivního listu
 For i = 1 To PocetListu
  JmenaListu = oDrgDoc.Sheets.Item(i).Name
  If JmenoAktualnihoListu = JmenaListu Then
   CisloAktivnihoListu = i
  End If
 Next
 If Zavrit = True Then
  oDrgDoc.Close
 End If
 ThisApplication.SilentOperation = False
End Function

Sub Prehled_DoplnujicichVykresu()
'Makro pro nalezení zúčastněných modelú a jejich výkresú
 Dim VykesSestavy As Inventor.DrawingDocument
 Dim Dil As Inventor.Document
 Dim Cesta As String
 Dim Jmeno As String
 Dim SeznamVykr As String
 Set VykesSestavy = ThisApplication.ActiveDocument
 PocetDilu = VykesSestavy.AllReferencedDocuments.Count
 Dim PocetVykresu As Integer
 PocetVykresu = 0
 Dim i As Integer
 i = 1
 For Each Dil In VykesSestavy.AllReferencedDocuments 'Opakuje pro každý díl vstupující do výkresu
  Set Dil = VykesSestavy.AllReferencedDocuments.Item(i) 'Načtení dílu
  Jmeno = Dil.DisplayName
  Cesta = Left(Dil.FullDocumentName, Len(Dil.FullDocumentName) - Len(Jmeno)) 'Cseta k soubouru bez jeho názvu
  Jmeno = Left(Jmeno, 4) + ".idw" 'Doplnění přípony výkreesu inventoru
  Cesta = Cesta + Jmeno 'Celá cesta k výkresu
  If Dir$(Cesta) <> "" Then 'Finta jak zjistit jestli soubor existuje
   SeznamVykr = SeznamVykr + Chr(10) + Jmeno
   If i = 1 Then
    Call TiskVykresu(Cesta, False)
   Else
    Call TiskVykresu(Cesta, True)
   End If
   PocetVykresu = PocetVykresu + 1 'Připočtení výkresu pokud existuje
  End If
  i = i + 1
 Next 'Konec načítání jednotlivých dílú výkresu
 MsgBox ("Počet dílú: " & PocetDilu & Chr(10) & "z toho výkresú: " & PocetVykresu & Chr(10) & SeznamVykr) 'Info co jsme vyčetli o souborech výkresu
End Sub