'******************************************************************************************************
'*** Beschreibung:  Prueft alle Zeichenansichten ob die Stuecklistensymbole der Stueckliste vergeben
'*                  sind.
'*
'*
'*** Hauptfunktionen:
'*          - Prueft ob eine Stueckliste vorhanden ist
'*          - Speichert Stueckliste in ein Feld
'*          - Prueft ob jedem KSS-Artikel eine Versionsnummer zugeordnet ist
'*          - Verknuepft alle Zeichenansichten mit der Stueckliste
'*          - Speichert alle Positions-Nummern der Stueckliste in ein Feld ab
'*          - Speichert alle Stuecklistensymbol-Nummern in ein Feld ab
'*          - Prueft ob jede Positions-Nummer auch als Stuecklistensymbol-Nummer vorhanden ist
'*
'*
'*** Hinweis:
'*          - Funktioniert nicht beim Stuecklisten-Typen "Nur oberste Ebene"
'*
'*
'*** Struktur der Prozeduren:
'*  - main
'*      - BOMTableAsArray
'*      - CheckVersions
'*      - PositionsAsArray
'*
'*
'* Stand: 17.02.2015
'* Autor: Lars Lederer
'******************************************************************************************************

Option Explicit
Option Compare Binary

' Name der benutzerdefinierten Eigenschaft zur Eingabe der Artikelnummer
Const GstrArtikelSpalte = "PartNo"
' Name der benutzerdefinierten Eigenschaft zur Eingabe der Version
Const GstrVersion = "Version"

Dim swApp                   As SldWorks.SldWorks

'*** main

Sub main()
    Dim swModel             As SldWorks.ModelDoc2
    Dim swDraw              As SldWorks.DrawingDoc
    Dim swView              As SldWorks.View
    Dim swNote              As SldWorks.Note
    Dim swFeat              As SldWorks.Feature
    Dim swBOMFeat           As SldWorks.BomFeature
    Dim swBOMTableAnn       As SldWorks.BomTableAnnotation
    Dim swTableAnn          As SldWorks.TableAnnotation
    Dim blnFound            As Boolean
    Dim varBOMTable         As Variant
    Dim varTables           As Variant
    Dim varTable            As Variant
    Dim intColumn           As Integer
    Dim intPosColumn        As Integer
    Dim intArtikelColumn    As Integer
    Dim intVersionColumn    As Integer
    Dim varNotes            As Variant
    Dim varNote             As Variant
    Dim varSheetNames       As Variant
    Dim varSheet            As Variant
    Dim intSheet            As Integer
    Dim varBOMBalloonNbrs() As Variant
    Dim intBOMNbr           As Integer
    Dim varPositions        As Variant
    Dim varMissingBOMs()    As Variant
    Dim intMissingBOMNbr    As Integer
    Dim intPositionNbr      As Integer
    Dim blnBOMFound         As Boolean
    Dim strBOMTableName     As String
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    ' Pruefung ob eine SolidWorks-Datei geoeffnet ist
    If swModel Is Nothing Then
        MsgBox "Kein Dokument geöffnet.", vbCritical
        End
    End If
    
    ' Ist die SolidWorks-Datei eine Zeichnung?
    If swModel.GetType <> swDocDRAWING Then
        MsgBox "Dieses Makro kann nur bei Zeichnungen ausgeführt werden.", vbCritical
        End
    End If
    
    blnFound = False
    
    Set swFeat = swModel.FirstFeature
    ' Schleife ueber alle Features der Zeichnung
    Do While Not swFeat Is Nothing
        ' Ist das Feature eine Stueckliste?
        If swFeat.GetTypeName = "BomFeat" Then
            ' Pruefung ob nicht schon eine Stückliste gefunden wurde
            If blnFound = True Then
                ' Es sind mindestens 2 Stuecklisten vorhanden
                MsgBox "Die Zeichnung enthält mehr als eine Stückliste.", vbExclamation
                Exit Sub
            End If
            ' Zeiger auf das Stuecklisten-Feature
            Set swBOMFeat = swFeat.GetSpecificFeature2
            strBOMTableName = swFeat.Name
            blnFound = True
        End If
        Set swFeat = swFeat.GetNextFeature
    Loop

    ' Stueckkliste gefunden?
    If blnFound = True Then
        ' Spalte nicht vorhanden = "-1"
        intPosColumn = -1
        ' Pruefung ob mindestens eine Tabelle vorliegt
        If swBOMFeat.GetTableAnnotationCount >= 1 Then
            varTables = swBOMFeat.GetTableAnnotations
            For Each varTable In varTables
                Set swTableAnn = varTable
                Set swBOMTableAnn = swTableAnn
                
                ' Schleife ueber alle Spalten der Tabelle
                For intColumn = 0 To swTableAnn.ColumnCount - 1
                    ' Welcher Spaltentyp liegt vor?
                    Select Case swTableAnn.GetColumnType(intColumn)
                    ' Spaltentyp "Position"
                    Case swBomTableColumnType_ItemNumber
                        ' Spaltennummer fuer Positionsnummer speichern
                        intPosColumn = intColumn
                    ' Spaltentyp "Benutzerdefiniert"
                    Case swTableColumnType_UserDefined
                        ' Welche benutzerdefinierte Eigenschaft ist der Spalte zugewiesen?
                        Select Case swBOMTableAnn.GetColumnCustomProperty(intColumn)
                        Case GstrArtikelSpalte
                            ' Spaltennummer fuer Artikelnummer speichern
                            intArtikelColumn = intColumn
                        ' Spaltentyp "Version"
                        Case GstrVersion
                            ' Spaltennummer fuer Positionsnummer speichern
                            intVersionColumn = intColumn
                        End Select
                    End Select
                Next
            Next
        End If
        ' Schreibe Stuecklisten-Tabelle in ein Feld
        varBOMTable = BOMTableAsArray(swTableAnn)
    
        ' Schreibe Positionen der Stueckliste in ein Feld
        varPositions = PositionsAsArray(varBOMTable, intPosColumn)
        
        ' Nur Ausfuehren wenn Positionen vorhanden sind
        If IsEmpty(varPositions) = False Then
            intSheet = 0
            intBOMNbr = 0
            
            Set swDraw = swModel
            ' Namen aller Zeichnungsblaetter an Feld uebergeben
            varSheetNames = swDraw.GetSheetNames
            
            ' Schleife ueber alle Zeichnungsblaetter-Namen
            For intSheet = 0 To UBound(varSheetNames)
                ' Blatt aktivieren
                swDraw.ActivateSheet varSheetNames(intSheet)
                Set swView = swDraw.GetFirstView
                Set swView = swView.GetNextView
                
                ' Schleife ueber alle Zeichenansichten des Blattes
                Do While Not swView Is Nothing
                    If swView.GetKeepLinkedToBOMName <> strBOMTableName Then
                        ' Zeichenansicht mit Stueckliste verknuepfen
                        swView.SetKeepLinkedToBOM True, strBOMTableName
                    End If
                    ' Alle Anmerkungen der Zeichenansicht an Feld uebergeben
                    varNotes = swView.GetNotes
                    ' Schleife ueber alle Anmerkungen
                    For Each varNote In varNotes
                        Set swNote = varNote
                        ' Ist die Anmerkung ein Stuecklistensymbol?
                        If swNote.IsBomBalloon <> False Then
                            ' Stuecklistensymbol-Text in Feld speichern
                            ReDim Preserve varBOMBalloonNbrs(intBOMNbr)
                            varBOMBalloonNbrs(intBOMNbr) = swNote.GetBomBalloonText(True)
                            intBOMNbr = intBOMNbr + 1
                        End If
                    Next
                    Set swView = swView.GetNextView
                Loop
            Next
        
            CheckVersions varBOMTable, intPosColumn, intArtikelColumn, intVersionColumn
            intMissingBOMNbr = 0
            ' Schleife ueber alle Positionen
            For intPositionNbr = 0 To UBound(varPositions)
                blnBOMFound = False
                ' Schleife ueber alle gefundenen Stuecklistensymbole
                For intBOMNbr = 0 To UBound(varBOMBalloonNbrs)
                    ' Position = Stuecklistensymbol?
                    If varBOMBalloonNbrs(intBOMNbr) = varPositions(intPositionNbr) Then
                        blnBOMFound = True
                        Exit For
                    End If
                Next
                ' Kein Stuecklistensymbol mit dieser Position gefunden
                If blnBOMFound = False Then
                    ' Nicht gefundenes Stuecklistensymbol an neues Feld uebergeben
                    ReDim Preserve varMissingBOMs(intMissingBOMNbr)
                    varMissingBOMs(intMissingBOMNbr) = varPositions(intPositionNbr)
                    intMissingBOMNbr = intMissingBOMNbr + 1
                End If
            Next
            ' Feld initialisiert?
            If Not Not varMissingBOMs Then
                ' Ausgabe des Felds mit den nicht gefundenes Stuecklistensymbolen
                MsgBox "Folgende Stücklistensymbole tauchen nicht in der Zeichnung auf:" & vbNewLine & Join(varMissingBOMs, ", "), vbExclamation
            Else
                MsgBox "Jeder Position der Stückliste ist ein Stücklistensymbol zugewiesen.", vbInformation
            End If
        Else
            MsgBox "Keine Positionsnummern gefunden.", vbExclamation
        End If
    Else
        MsgBox "Keine Stückliste gefunden.", vbExclamation
    End If
End Sub

'*** BOMTableAsArray
' Wandelt Tabelle in Feld (Zeilen, Spalten) um
' IN:   Stueckliste als BomFeature
'
' OUT:  Stuecklistenfeld als Variant

Function BOMTableAsArray(swTableAnn As SldWorks.TableAnnotation) As Variant
    Dim varBOMTable         As Variant
    Dim intRow              As Integer
    Dim intColumn           As Integer
    
    ' Feldgroesse definieren in Abhaengigkeit der Stuecklisten-Zeilen und -Spalten
    ReDim varBOMTable(swTableAnn.RowCount - 1, swTableAnn.ColumnCount - 1)
    For intRow = 0 To swTableAnn.RowCount - 1
        For intColumn = 0 To swTableAnn.ColumnCount - 1
            ' Stueckliste Feld fuer Feld einlesen
            varBOMTable(intRow, intColumn) = swTableAnn.Text(intRow, intColumn)
        Next
    Next
    BOMTableAsArray = varBOMTable
End Function

'*** CheckVersions
' Ueberprueft ob dem Artikel eine Versionsnummer zugeordnet ist (nur bei Artikel-Praefix "KSS." und kein E-Plan)
' IN:   Stuecklistenfeld als Variant
'       Positionsspalte als Integer
'       Artikelspalte als Integer
'       Versionsspalte als Integer
'
' OUT:  -

Sub CheckVersions(varBOMTable As Variant, intPosColumn As Integer, intArtikelColumn As Integer, intVersionColumn As Integer)
    Dim intRow              As Integer
    Dim intColumn           As Integer
    Dim blnCompare          As Boolean
    Dim intLengthArtikel    As Integer
    Dim strArtikelNoPrefix  As String
    Dim intMissingVerNbr    As Integer
    Dim varMissingVers()    As Variant
    
    intMissingVerNbr = 0
    
    ' Erste Zeile auslassen, da nur Spalten-Ueberschrift
    For intRow = 1 To UBound(varBOMTable, 1)
        ' Artikelspezifisch: Alles rechts vom ersten Punkt abschneiden -> Kuerzel vor Artikelnummer isoliert
        ' Ist Kuerzel = "KSS" fuehre Vergleich mit Zeichnungsnummer durch
        Select Case StrConv(Left(varBOMTable(intRow, intArtikelColumn), InStr(varBOMTable(intRow, intArtikelColumn), ".")), vbUpperCase)
        Case "KSS."
            blnCompare = True
            strArtikelNoPrefix = Mid(varBOMTable(intRow, intArtikelColumn), InStr(varBOMTable(intRow, intArtikelColumn), ".") + 1)
        Case Else
            blnCompare = False
        End Select
        
        If blnCompare = True Then
            ' Artikelspezifisch: Pruefung ob "-sp" am Ende des Artikels steht (Signalwort fuer gespiegeltes Teil)
            If StrComp(Mid(varBOMTable(intRow, intArtikelColumn), InStrRev(varBOMTable(intRow, intArtikelColumn), "-")), "-sp", vbTextCompare) = False Then
                ' Zeichenanzahl des Artikels bis zum letzten "-"
                intLengthArtikel = InStrRev(strArtikelNoPrefix, "-") - 1
            Else
                ' Zeichenanzahl des Artikels
                intLengthArtikel = Len(strArtikelNoPrefix)
            End If
            ' Wenn Artikel kein E-Plan
            If (Mid(strArtikelNoPrefix, InStrRev(Left(strArtikelNoPrefix, intLengthArtikel), "-") + 1) Like "E*") = False Then
                ' Ist fuer diesen Artikel der Text in Spalte Version eine Nummer?
                If IsNumeric(varBOMTable(intRow, intVersionColumn)) = False Then
                    ' Position mit nicht vorhandener Version an neues Feld uebergeben
                    ReDim Preserve varMissingVers(intMissingVerNbr)
                    varMissingVers(intMissingVerNbr) = varBOMTable(intRow, intPosColumn)
                    intMissingVerNbr = intMissingVerNbr + 1
                End If
            End If
        End If
    Next
    
    ' Feld mit fehlenden Versionen initialisiert?
    If Not Not varMissingVers Then
        ' Ausgabe des Felds mit den nicht gefundenes Stuecklistensymbolen
        MsgBox "Folgende Positionen besitzen keine Version:" & vbNewLine & Join(varMissingVers, ", "), vbExclamation
    End If
End Sub

'*** PositionsAsArray
' Weist die Positionen der uebergebenen Stueckliste einem eigenen Feld zu
' IN:   Stuecklistenfeld als Variant
'       Positionsspalte als Integer
'
' OUT:  Positionen der Stueckliste als eindimensionales Feld

Function PositionsAsArray(varBOMTable As Variant, intPosColumn) As Variant
    Dim intRow              As Integer
    Dim varPositions()      As Variant

    If UBound(varBOMTable, 1) > 1 Then
        ' Feldgroesse definieren in Abhaengigkeit der Stuecklisten-Zeilen
        ReDim varPositions(UBound(varBOMTable, 1) - 1)
        For intRow = 1 To UBound(varBOMTable, 1)
            ' Positionen Zeile fuer Zeile einlesen
            varPositions(intRow - 1) = varBOMTable(intRow, intPosColumn)
        Next
        PositionsAsArray = varPositions
    End If
End Function