Option Explicit

Const EXCEL_FILE_PATH As String = "C:\Tavs\Cels\LKS_Transformacijas_Kalkulators_Pilns.xlsm"
Const GCS_COMMAND As String = "geocoordinate dialog"

Public Sub LKS_Transformacija()
    Dim userInput As String
    
    userInput = InputBox("Kuru transformāciju veikt?" & vbCrLf & vbCrLf & _
                         "1 - No LKS92 uz LKS2020" & vbCrLf & _
                         "2 - No LKS2020 uz LKS92" & vbCrLf & vbCrLf & _
                         "Ievadi ciparu 1 vai 2 un spied OK (vai Cancel, lai pārtrauktu):", _
                         "Transformācijas virziens", "1")
    
    If userInput = "" Then Exit Sub
    
    If userInput <> "1" And userInput <> "2" Then
        MsgBox "Kļūdaina ievade! Jāievada 1 vai 2. Darbība atcelta.", vbExclamation, "Kļūda"
        Exit Sub
    End If
    
    Dim isFwd As Boolean
    isFwd = (userInput = "1")
    
    Dim ee As ElementEnumerator
    Dim useFence As Boolean
    
    If ActiveDesignFile.Fence.IsDefined Then
        useFence = True
        Set ee = ActiveDesignFile.Fence.GetContents()
    Else
        useFence = False
        Dim esc As New ElementScanCriteria
        esc.ExcludeNonGraphical
        Set ee = ActiveModelReference.GraphicalElementCache.Scan(esc)
    End If
    
    Dim rangeMin As Point3d
    Dim rangeMax As Point3d
    Dim firstElem As Boolean
    firstElem = True
    
    Dim elems() As Element
    Dim elemCount As Long
    elemCount = 0
    
    Do While ee.MoveNext
        ReDim Preserve elems(elemCount)
        Set elems(elemCount) = ee.Current
        
        If firstElem Then
            rangeMin = ee.Current.Range.Low
            rangeMax = ee.Current.Range.High
            firstElem = False
        Else
            If ee.Current.Range.Low.X < rangeMin.X Then rangeMin.X = ee.Current.Range.Low.X
            If ee.Current.Range.Low.Y < rangeMin.Y Then rangeMin.Y = ee.Current.Range.Low.Y
            If ee.Current.Range.High.X > rangeMax.X Then rangeMax.X = ee.Current.Range.High.X
            If ee.Current.Range.High.Y > rangeMax.Y Then rangeMax.Y = ee.Current.Range.High.Y
        End If
        elemCount = elemCount + 1
    Loop
    
    If elemCount = 0 Then
        MsgBox "Nav atrasts neviens grafisks elements!", vbExclamation, "Kļūda"
        Exit Sub
    End If
    
    ' ==============================================================================
    ' PRE-SCAN: KRUSTU DROŠĪBAS PĀRBAUDE (Pirms jebkādas pārvietošanas)
    ' ==============================================================================
    If Not isFwd Then
        Dim k As Long
        For k = 0 To elemCount - 1
            If elems(k).Type = msdElementTypeCellHeader Then
                If UCase(elems(k).AsCellElement.Name) = "KRUSTS" Then
                    Dim tmpLvl As Level
                    Dim tmpLvlName As String
                    tmpLvlName = ""
                    
                    On Error Resume Next
                    Set tmpLvl = elems(k).Level
                    If tmpLvl Is Nothing Then
                        If elems(k).IsComplexElement Then
                            Dim sEnum As ElementEnumerator
                            Set sEnum = elems(k).AsComplexElement.GetSubElements
                            If sEnum.MoveNext Then
                                Set tmpLvl = sEnum.Current.Level
                            End If
                        End If
                    End If
                    On Error GoTo 0
                    
                    If Not tmpLvl Is Nothing Then tmpLvlName = UCase(tmpLvl.Name)
                    
                    ' Pārbaudām, vai krusts nav īstajā LKS2020 līmenī
                    If tmpLvlName Like "GEOD_ELEM_*" And tmpLvlName <> "GEOD_ELEM_LKS2020" Then
                        Dim ansKrusts As Integer
                        ansKrusts = MsgBox("Uzmanību! Tiek veikta transformācija uz LKS92, bet failā atrasti " & _
                                           "KRUSTI, kas atrodas līmenī '" & tmpLvlName & "' (nevis GEOD_ELEM_LKS2020)." & vbCrLf & vbCrLf & _
                                           "Vai tiešām turpināt transformāciju un piešķirt tiem LKS92 līmeni?", _
                                           vbYesNo + vbExclamation, "Krustu brīdinājums")
                        If ansKrusts = vbNo Then
                            ' Lietotājs atcēla procesu - grafika vēl nav aiztikta, izejam ārā tīri
                            Exit Sub
                        Else
                            ' Lietotājs piekrita, izejam no pārbaudes cikla un turpinām tālāk
                            Exit For
                        End If
                    End If
                End If
            End If
        Next k
    End If
    
    Dim centroid As Point3d
    centroid.X = (rangeMin.X + rangeMax.X) / 2
    centroid.Y = (rangeMin.Y + rangeMax.Y) / 2
    centroid.Z = 0
    
    ' Savienojums ar Excel
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim xlAppCreated As Boolean
    Dim xlWBCreated As Boolean
    
    xlAppCreated = False
    xlWBCreated = False
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
        xlAppCreated = True
    End If
    On Error GoTo 0
    
    Dim wb As Object
    Dim wbFound As Boolean
    wbFound = False
    
    For Each wb In xlApp.Workbooks
        If InStr(1, wb.Name, "Kalkulators", vbTextCompare) > 0 Or InStr(1, wb.Name, ".xls", vbTextCompare) > 0 Then
            Set xlWB = wb
            wbFound = True
            Exit For
        End If
    Next wb
    
    If Not wbFound Then
        If Dir(EXCEL_FILE_PATH) = "" Then
            MsgBox "Nav atrasts Excel fails: " & EXCEL_FILE_PATH, vbCritical, "Kļūda"
            If xlAppCreated Then xlApp.Quit
            Set xlApp = Nothing
            Exit Sub
        End If
        Set xlWB = xlApp.Workbooks.Open(EXCEL_FILE_PATH)
        xlWBCreated = True
    End If
    
    Set xlSheet = xlWB.Sheets("Kalkulators")
    
    Dim shiftX As Double, shiftY As Double
    
    If Not useFence Then
        Dim shiftMinX As Double, shiftMinY As Double
        Dim shiftMaxX As Double, shiftMaxY As Double
        
        Call GetExcelShift(xlSheet, isFwd, rangeMin.X, rangeMin.Y, shiftMinX, shiftMinY)
        Call GetExcelShift(xlSheet, isFwd, rangeMax.X, rangeMax.Y, shiftMaxX, shiftMaxY)
        
        Dim deformX As Double, deformY As Double
        deformX = Abs(shiftMaxX - shiftMinX)
        deformY = Abs(shiftMaxY - shiftMinY)
        
        Dim deformM As Double
        deformM = Sqr(deformX * deformX + deformY * deformY) * 1000
        
        Call GetExcelShift(xlSheet, isFwd, centroid.X, centroid.Y, shiftX, shiftY)
        Dim shiftCentroidM As Double
        shiftCentroidM = Sqr(shiftX * shiftX + shiftY * shiftY) * 1000
        
        Dim ans As Integer
        ans = MsgBox("BRĪDINĀJUMS: Nav iezīmēts Fence, tiek analizēts viss fails!" & vbCrLf & vbCrLf & _
                     "Tālāko objektu matemātiskā deformācija: " & Round(deformM, 1) & " mm" & vbCrLf & _
                     "Centroīda kopējais pārvietojums: " & Round(shiftCentroidM, 1) & " mm" & vbCrLf & vbCrLf & _
                     "Vai turpināt visa faila pārvietošanu pa centroīda nobīdi?", vbYesNo + vbExclamation, "Apstiprināt transformāciju")
                     
        If ans = vbNo Then GoTo CleanUp
    Else
        Call GetExcelShift(xlSheet, isFwd, centroid.X, centroid.Y, shiftX, shiftY)
    End If
    
    ' ==============================================================================
    ' Objektu Filtrēšana un Pārvietošana
    ' ==============================================================================
    Dim i As Long
    Dim moveVec As Point3d
    moveVec.X = shiftX
    moveVec.Y = shiftY
    moveVec.Z = 0
    
    For i = 0 To elemCount - 1
        Dim el As Element
        Set el = elems(i)
        
        Dim oLevel As Level
        Dim lvlName As String
        lvlName = ""
        
        On Error Resume Next
        Set oLevel = el.Level
        If oLevel Is Nothing Then
            If el.IsComplexElement Then
                Dim subEnum As ElementEnumerator
                Set subEnum = el.AsComplexElement.GetSubElements
                If subEnum.MoveNext Then
                    Set oLevel = subEnum.Current.Level
                End If
            End If
        End If
        On Error GoTo 0
        
        If Not oLevel Is Nothing Then
            lvlName = UCase(oLevel.Name)
        End If
        
        Dim bMove As Boolean
        bMove = True
        
        If lvlName <> "" Then
            ' 1. Filtrējam tekstu līmeņos GEOD_KORD_####_TKST_#
            If el.Type = msdElementTypeText Or el.Type = msdElementTypeTextNode Then
                If lvlName Like "GEOD_KORD_*_TKST_*" Then
                    bMove = False
                End If
            End If
            
            ' 2. Filtrējam šūnu "KRUSTS"
            If el.Type = msdElementTypeCellHeader Then
                If UCase(el.AsCellElement.Name) = "KRUSTS" Then
                    If isFwd Then
                        ' No 92 uz 2020
                        If lvlName Like "GEOD_ELEM_*" Then
                            bMove = False
                            Call ChangeElementLevel(el, "GEOD_ELEM_LKS2020")
                        End If
                    Else
                        ' No 2020 uz 92
                        If lvlName Like "GEOD_ELEM_*" Then
                            bMove = False
                            ' Vairs nejautājam, jo atļauja saņemta Pre-Scan blokā
                            Call ChangeElementLevel(el, "GEOD_ELEM_LKS92")
                        End If
                    End If
                End If
            End If
        End If
        
        ' 3. Pārvietojam
        If bMove Then
            el.Move moveVec
            el.Rewrite
        End If
    Next i
    
    ' ==============================================================================
    ' Līmeņa izveide un indikācijas līnijas zīmēšana
    ' ==============================================================================
    Dim resultLvlName As String
    Dim systemFrom As String
    Dim systemTo As String
    If isFwd Then
        resultLvlName = "NO_LKS92_UZ_LKS2020"
        systemFrom = "LKS92"
        systemTo = "LKS2020"
    Else
        resultLvlName = "NO_LKS2020_uz_LKS92"
        systemFrom = "LKS2020"
        systemTo = "LKS92"
    End If
    
    Dim resLvl As Level
    On Error Resume Next
    Set resLvl = ActiveDesignFile.Levels(resultLvlName)
    On Error GoTo 0
    If resLvl Is Nothing Then
        Set resLvl = ActiveDesignFile.AddNewLevel(resultLvlName)
    End If
    
    Dim p2 As Point3d
    p2.X = centroid.X + shiftX
    p2.Y = centroid.Y + shiftY
    p2.Z = centroid.Z
    
    Dim lineEl As LineElement
    Set lineEl = CreateLineElement2(Nothing, centroid, p2)
    lineEl.Level = resLvl
    lineEl.Color = 3
    lineEl.LineWeight = 3
    ActiveModelReference.AddElement lineEl
    
    If useFence Then ActiveDesignFile.Fence.Undefine
    
    ' ==============================================================================
    ' GCS Kopsavilkums un izsaukums
    ' ==============================================================================
    Dim endMsg As String
    endMsg = "Transformācija veiksmīga! Grafika pabīdīta virzienā " & systemFrom & " -> " & systemTo & vbCrLf & _
             "Vektors (m): dX = " & Round(shiftX, 3) & " | dY = " & Round(shiftY, 3) & vbCrLf & vbCrLf & _
             "Nākamais solis: Jāatjaunina faila koordinātu sistēma (GCS)." & vbCrLf & _
             "Makross tagad mēģinās automātiski atvērt GCS logu." & vbCrLf & vbCrLf & _
             "JA LOGS NEATVERAS (citas MicroStation versijas dēļ):" & vbCrLf & _
             "1. Atver to manuāli: Tools -> Geographic -> Select Geographic Coordinate System" & vbCrLf & _
             "2. Vai izlabo komandu makrosa sākumā (Mainīgais: GCS_COMMAND)." & vbCrLf & vbCrLf & _
             "Vai mēģināt atvērt logu tagad?"
             
    If MsgBox(endMsg, vbYesNo + vbInformation, "Transformācija Pabeigta") = vbYes Then
        CadInputQueue.SendCommand GCS_COMMAND
    End If

CleanUp:
    On Error Resume Next ' Ja Excel jau ir "miris", kods neapstājas un turpina tīrīšanu
    Set xlSheet = Nothing
    
    If xlWBCreated And Not xlWB Is Nothing Then
        xlApp.DisplayAlerts = False ' Agresīvi izslēdz visus neredzamos Excel paziņojumus (piemēram, "Save Changes?")
        xlWB.Close SaveChanges:=False
    End If
    Set xlWB = Nothing
    
    If xlAppCreated And Not xlApp Is Nothing Then
        xlApp.DisplayAlerts = False
        xlApp.Quit
    End If
    Set xlApp = Nothing
    On Error GoTo 0
End Sub

' ------------------------------------------------------------------------------
' PALĪGFUNKCIJA: Droša līmeņa nomaiņa/izveide filtrētajiem elementiem
' ------------------------------------------------------------------------------
Private Sub ChangeElementLevel(ByVal el As Element, ByVal targetLevelName As String)
    Dim lvl As Level
    On Error Resume Next
    Set lvl = ActiveDesignFile.Levels(targetLevelName)
    On Error GoTo 0
    
    If lvl Is Nothing Then
        Set lvl = ActiveDesignFile.AddNewLevel(targetLevelName)
    End If
    
    el.Level = lvl
    el.Rewrite
End Sub

' ------------------------------------------------------------------------------
' PALĪGFUNKCIJA: Komunikācija ar Excel šūnām
' ------------------------------------------------------------------------------
Private Sub GetExcelShift(xlSheet As Object, isFwd As Boolean, X As Double, Y As Double, ByRef dX As Double, ByRef dY As Double)
    If isFwd Then
        xlSheet.Range("B2").Value = X
        xlSheet.Range("C2").Value = Y
        xlSheet.Calculate
        dX = xlSheet.Range("D2").Value - X
        dY = xlSheet.Range("E2").Value - Y
    Else
        xlSheet.Range("H2").Value = X
        xlSheet.Range("I2").Value = Y
        xlSheet.Calculate
        dX = xlSheet.Range("J2").Value - X
        dY = xlSheet.Range("K2").Value - Y
    End If
End Sub

