Charlesúv blog: 2017

Černý orel - Black Eagle

paper: 710 x 710 mm ; 70 g/m²

model: wing span 360 mm

design: Nguyen Hung Cuong

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