' Programm: Layers
' Erstellt von : Michael Knaupp
' Datum: 
' Änderungen:


Option Strict Off
Imports System
Imports System.Windows.Forms
Imports NXOpen
Imports NXOpen.UI
Imports NXOpen.Utilities
Imports NXOpen.Assemblies
Imports NXOpen.UF
Imports NXOpenUI
Imports layer_organize.NX_Tools

Module Kr_Api_layer_organize

    Dim s As Session = Session.GetSession()
    Dim lw As ListingWindow = s.ListingWindow
    Dim wP As Part = s.Parts.Work
    Dim dp As Part = s.Parts.Display
    Dim theUI As UI = UI.GetUI()
    Dim ufs As UFSession = UFSession.GetUFSession()
    Dim UGII_LANG As Integer = getnxlang()
    Dim cr As Char = Chr(13)
    Dim inputcorr As Boolean = False
    ' ----------------------------------------------
    '  Layerdefinition
    ' ----------------------------------------------
    Dim L_lower_Body As Integer = 1 'Layer fuer Solidbodys
    Dim L_upper_Body As Integer = 19 'Layer fuer Solidbodys

    Dim l_flat_body As Integer = 19 ' Layer fuer Abwickhlung

    Dim L_lower_Sheet_B As Integer = 20 'Layer für Flaechenkoerper
    Dim L_upper_Sheet_B As Integer = 39 'Layer für Flaechenkoerper

    Dim L_lower_Sk As Integer = 40 'Kat wert von für Skizzen
    Dim L_upper_Sk As Integer = 59 'Kat wert bis für Skizzen

    Dim L_Ksys As Integer = 60 'Layer für DatumKsys
    Dim L_Datums As Integer = 61 'Bezugselemente ausser Ksys
    Dim L_lower_Datums As Integer = 60 'Kat wert bis Datums
    Dim L_upper_Datums As Integer = 79 'Kat wert von Datums

    Dim L_lower_curves As Integer = 80 'Layer für Kurven
    Dim L_upper_curves As Integer = 99  'Layer für Kurven

    Dim L_lower_punkte As Integer = 100 'Layer für Punkte
    Dim L_upper_punkte As Integer = 119 'Layer für Punkte

    Dim L_german_text As Integer = 120 'Layer fuer deutsche Texte
    Dim L_english_text As Integer = 130 'Layer fuer englische Texte

    Dim L_lower_pmi As Integer = 150 ' Layer fuer PMI
    Dim L_upper_pmi As Integer = 160 ' Layer fuer PMI

    Dim L_Starthole As Integer = 200 'Layer für Startloch

    Dim L_trash As Integer = 256 'Layer fuer muell

    Dim startlayer As Integer = 0


    Sub Main()

        Dim errmsg As String = ""
        Dim UGII_LANG As Integer = getnxlang()

        If check_if_part_loaded() = False Then
            Exit Sub
        End If

        Dim module_id = 0
        ufs.UF.AskApplicationModule(module_id)
        If module_id = UFConstants.UF_APP_MODELING Or module_id = UFConstants.UF_APP_SBSM Then
        Else
            If UGII_LANG = nxlang.de Then
                Windows.Forms.MessageBox.Show("Sie sind nicht in der Applikation Modeling oder Sheet Metal")
            Else
                Windows.Forms.MessageBox.Show("You are not in Modeling or Sheet Metal Module")
            End If
            Exit Sub
        End If


        If writabel(wP) = False Then
            If UGII_LANG = nxlang.de Then
                errmsg = "Teil ist schreibgeschutzt, beende Programm"
            Else
                errmsg = "Part is write protected, quit Programm"
            End If
            MessageBox.Show(errmsg)
            Exit Sub
        End If

        Dim root As Component = wP.ComponentAssembly.RootComponent
        If report_if_assembly(root) = True Then
            If UGII_LANG = nxlang.de Then
                errmsg = "Dies ist eine Baugruppe. Layer werden nur in Einzelteilen belget" & cr & "Falls doch noetig bitte manuell belegen."
            Else
                errmsg = "This Part is an Assembly. Layers should only be used in Parts" & cr & "If necessary please do manually"
            End If
            MessageBox.Show(errmsg)
            Exit Sub
        End If

        If wP IsNot dp Then
            If UGII_LANG = nxlang.de Then
                errmsg = "Arbeitsteil ist nicht dargestelltes Teil!" & cr & "Bitte aendern Sie dies."
            Else
                errmsg = "Work Part is not displayed Part!" & cr & "Please change that."
            End If
            MessageBox.Show(errmsg)
            Exit Sub
        End If

        module_id = 0
        If module_id = UFConstants.UF_APP_SKETCHER Then
            If UGII_LANG = nxlang.de Then
                errmsg = "Bitte den Skizzen Modus verlassen."
            Else
                errmsg = "Please leave sketcher."
            End If
            MessageBox.Show(errmsg)
            Exit Sub
        End If

        'und los kanns gehen
        ' ----------------------------------------------
        '  alle Layer auf unsichtbar setzen
        ' ----------------------------------------------
        Dim layercol As Layer.StateCollection
        layercol = wP.Layers.GetStates()
        Dim lcat As Layer.Category = CType(wP.LayerCategories.FindObject("ALL"), Layer.Category)
        layercol.SetStateOfCategory(lcat, Layer.State.Hidden)
        wP.Layers.SetStates(layercol, False)
        layercol.Dispose()

        ' ----------------------------------------------
        '  vorhandene Kategorien löschen
        ' ----------------------------------------------
        Dim objlc As Layer.Category

        For Each objlc In wP.LayerCategories.ToArray
            ufs.Obj.DeleteObject(objlc.Tag)
        Next

        ' ----------------------------------------------
        '  Ansicht orientieren->Trimetrisch
        ' ----------------------------------------------
        wP.ModelingViews.WorkView.Orient(NXOpen.View.Canned.Trimetric, NXOpen.View.ScaleAdjustment.Fit)
        wP.ModelingViews.WorkView.Regenerate()

        ' ----------------------------------------------
        '  Kategorien setzen/erzeugen
        ' ----------------------------------------------
        set_category(L_lower_Body, L_upper_Body, "Koerper-Body")
        set_category(l_flat_body, l_flat_body, "Abwicklung-Flat_Solid")
        set_category(L_lower_Sheet_B, L_upper_Sheet_B, "Flaechen-Sheet_Body")
        set_category(L_lower_Sk, L_upper_Sk, "Skizzen-Sketch")
        set_category(L_lower_Datums, L_upper_Datums, "Bezugselement-Datums")
        set_category(L_lower_curves, L_upper_curves, "Kurven-Curve")
        set_category(L_lower_punkte, L_upper_punkte, "Punkte-Points")
        set_category(L_german_text, L_german_text, "TEXT_D-Text_German")
        set_category(L_english_text, L_english_text, "TEXT_E-Text_English")
        set_category(L_lower_pmi, L_upper_pmi, "PMI")
        set_category(L_Starthole, L_Starthole, "Starloch-WEDM_Hole")
        set_category(L_trash, L_trash, "Muell-Trash")

        If UGII_LANG = nxlang.de Then
            s.SetUndoMark(Session.MarkVisibility.Visible, "Kategorie gesetzt")
        Else
            s.SetUndoMark(Session.MarkVisibility.Visible, "set catagories")
        End If

        ' ----------------------------------------------
        '  Objekte auf Layer verschieben
        ' ----------------------------------------------
        Dim objArray(0) As DisplayableObject

        'Skizze auf Layer 61 verschieben
        inputcorr = False
        startlayer = L_lower_Sk
        For Each sketchobj As DisplayableObject In wP.Sketches
            If sketchobj.Layer > 256 Then Continue For
            If Not sketchobj.IsBlanked AndAlso wP.Layers.GetState(sketchobj.Layer) <> Layer.State.Hidden Then
                objArray(0) = sketchobj
                sketchobj.Highlight()
                wP.Views.Refresh()

                Do Until inputcorr = True
                    Try
                        startlayer = NXInputBox.GetInputNumber(sketchobj.Name + " - Layer " + Str(L_lower_Sk) + " - " + Str(L_upper_Sk), "Sketch - Skizze", startlayer)
                        If startlayer < L_lower_Sk Or startlayer > L_upper_Sk Then
                            If UGII_LANG = nxlang.de Then
                                MsgBox("Bitte Nummer zwischen: " & L_lower_Sk.ToString & " und: " & L_upper_Sk.ToString & " eingeben.")
                            Else
                                MsgBox("Please enter a number between: " & L_lower_Sk.ToString & " and: " & L_upper_Sk.ToString & ".")
                            End If
                            inputcorr = False
                        Else
                            inputcorr = True
                        End If

                    Catch fex As FormatException
                        If UGII_LANG = nxlang.de Then
                            MsgBox("Bitte Nummer eingenben!")
                        Else
                            MsgBox("Please enter a NUMBER!")
                        End If
                        inputcorr = False
                    End Try
                Loop

                wP.Layers.MoveDisplayableObjects(Val(startlayer), objArray)

                sketchobj.Unhighlight()
                inputcorr = False

                startlayer = startlayer + 1

                If startlayer >= L_upper_Sk Then
                    startlayer = L_lower_Sk
                End If

            End If
        Next
        If UGII_LANG = nxlang.de Then
            s.SetUndoMark(Session.MarkVisibility.Visible, "Skizzen Layer")
        Else
            s.SetUndoMark(Session.MarkVisibility.Visible, "sketches layer")
        End If

        ' Kurven auf Layer 80 verschieben....
        startlayer = L_lower_curves
        For Each curveobj As DisplayableObject In wP.Curves
            If curveobj.Layer > 256 Then Continue For
            If Not curveobj.IsBlanked AndAlso wP.Layers.GetState(curveobj.Layer) <> Layer.State.Hidden Then
                Dim an_feat As NXOpen.Tag = NXOpen.Tag.Null
                ufs.Modl.AskObjectFeat(curveobj.Tag, an_feat)
                If an_feat <> NXOpen.Tag.Null Then
                    Dim nxfeatobj As NXOpen.Features.Feature = NXOpen.Utilities.NXObjectManager.Get(an_feat)
                    If Not nxfeatobj.FeatureType.StartsWith("SYMBOLIC_THREAD") Then
                        objArray(0) = curveobj
                        wP.Layers.MoveDisplayableObjects(startlayer, objArray)
                    End If
                Else
                    objArray(0) = curveobj
                    wP.Layers.MoveDisplayableObjects(startlayer, objArray)
                End If
            End If
        Next

        If UGII_LANG = nxlang.de Then
            s.SetUndoMark(Session.MarkVisibility.Visible, "Kurven Layer")
        Else
            s.SetUndoMark(Session.MarkVisibility.Visible, "curves layer")
        End If


        'DATUMS auf Layer 60 / 61 verschieben
        inputcorr = False
        startlayer = L_Datums

        For Each datumobj As DisplayableObject In wP.Datums
            'Filtern von Sheet Metal objekten
            If datumobj.JournalIdentifier.Contains("SB_") Then Continue For
            'Filtern von Datums in Sketchen, sind auf layer 271
            If datumobj.Layer > 256 Then Continue For
            If Not datumobj.IsBlanked AndAlso wP.Layers.GetState(datumobj.Layer) <> Layer.State.Hidden Then

                Dim an_feat As NXOpen.Tag = NXOpen.Tag.Null
                ufs.Modl.AskObjectFeat(datumobj.Tag, an_feat)
                If an_feat <> NXOpen.Tag.Null Then

                    Dim datumfeat As NXOpen.Features.Feature = NXOpen.Utilities.NXObjectManager.Get(an_feat)
                    If Not datumfeat.FeatureType.StartsWith("DATUM_CSYS") Then
                        objArray(0) = datumobj
                        datumobj.Highlight()
                        wP.Views.Refresh()

                        Do Until inputcorr = True
                            Try
                                startlayer = NXInputBox.GetInputNumber(datumobj.JournalIdentifier + " - Layer " + Str(L_Datums) + " - " + Str(L_upper_Datums), "Datum - Ebene", startlayer)
                                If startlayer < L_Datums Or startlayer > L_upper_Datums Then
                                    If UGII_LANG = nxlang.de Then
                                        MsgBox("Bitte Nummer zwischen: " & L_Datums.ToString & " und: " & L_upper_Datums.ToString & " eingeben.")
                                    Else
                                        MsgBox("Please enter a number between: " & L_Datums.ToString & " and: " & L_upper_Datums.ToString & ".")
                                    End If
                                    inputcorr = False
                                Else
                                    inputcorr = True
                                End If

                            Catch fex As FormatException
                                If UGII_LANG = nxlang.de Then
                                    MsgBox("Bitte Nummer eingenben!")
                                Else
                                    MsgBox("Please enter a NUMBER!")
                                End If
                                inputcorr = False
                            End Try
                        Loop

                        wP.Layers.MoveDisplayableObjects(Val(startlayer), objArray)

                        datumobj.Unhighlight()
                        inputcorr = False

                        startlayer = startlayer + 1

                        If startlayer >= L_upper_Datums Then
                            startlayer = L_Datums
                        End If

                    ElseIf datumfeat.FeatureType.StartsWith("DATUM_CSYS") Then
                        objArray(0) = datumobj
                        wP.Layers.MoveDisplayableObjects(L_Ksys, objArray)
                    End If


                End If

            End If
        Next

        If UGII_LANG = nxlang.de Then
            s.SetUndoMark(Session.MarkVisibility.Visible, "Bezugsobj Layer")
        Else
            s.SetUndoMark(Session.MarkVisibility.Visible, "Datums layer")
        End If


        'Flächen auf Layer 20 verschieben
        Dim bodies As BodyCollection = wP.Bodies

        lw.Open()
        For Each mybod As Body In wP.Bodies
            If mybod.IsSheetBody = True Then
                If mybod.Layer > 256 Then Continue For
                If Not mybod.IsBlanked AndAlso wP.Layers.GetState(mybod.Layer) <> Layer.State.Hidden Then
                    Dim mybodname As String = mybod.Name
                    Dim mybodstr As String = mybod.ToString
                    If mybodname = "STARTLOCHBOHRUNG" Then
                        'Startlochbohrung gefunden...
                        objArray(0) = mybod
                        wP.Layers.MoveDisplayableObjects(L_Starthole, objArray)
                    Else
                        'Flaeche gefunden...
                        objArray(0) = mybod
                        wP.Layers.MoveDisplayableObjects(L_lower_Sheet_B, objArray)
                    End If
                End If
            End If
        Next

        If UGII_LANG = nxlang.de Then
            s.SetUndoMark(Session.MarkVisibility.Visible, "Flaechen layer")
        Else
            s.SetUndoMark(Session.MarkVisibility.Visible, "sheet bodies layer")
        End If


        'Punkte auf Layer 100 verschieben
        For Each pointobj As DisplayableObject In wP.Points
            If pointobj.Layer > 256 Then Continue For
            If Not pointobj.IsBlanked AndAlso wP.Layers.GetState(pointobj.Layer) <> Layer.State.Hidden Then
                Dim an_feat As NXOpen.Tag = NXOpen.Tag.Null
                ufs.Modl.AskObjectFeat(pointobj.Tag, an_feat)
                If an_feat <> NXOpen.Tag.Null Then
                    Dim pointfeat As NXOpen.Features.Feature = NXOpen.Utilities.NXObjectManager.Get(an_feat)
                    If Not pointfeat.FeatureType.StartsWith("DATUM_CSYS") Then
                        objArray(0) = pointobj
                        wP.Layers.MoveDisplayableObjects(L_lower_punkte, objArray)
                    ElseIf pointfeat.FeatureType.StartsWith("DATUM_CSYS") Then
                        objArray(0) = pointobj
                        wP.Layers.MoveDisplayableObjects(L_Ksys, objArray)
                    End If
                End If
            End If
        Next

        If UGII_LANG = nxlang.de Then
            s.SetUndoMark(Session.MarkVisibility.Visible, "punkte layer")
        Else
            s.SetUndoMark(Session.MarkVisibility.Visible, "points layer")
        End If


        ' CSYS auf Layer 60 schieben....
        For Each csysobj As DisplayableObject In wP.CoordinateSystems
            If csysobj.Layer > 256 Then Continue For
            If Not csysobj.IsBlanked AndAlso wP.Layers.GetState(csysobj.Layer) <> Layer.State.Hidden Then
                objArray(0) = csysobj
                wP.Layers.MoveDisplayableObjects(L_Ksys, objArray)
            End If
        Next



        ' ----------------------------------------------
        '  Ansicht orientieren->Trimetrisch
        ' ----------------------------------------------
        wP.ModelingViews.WorkView.Orient(NXOpen.View.Canned.Trimetric, NXOpen.View.ScaleAdjustment.Fit)
        wP.ModelingViews.WorkView.Regenerate()


    End Sub


    Sub set_category(ByVal range1, ByVal range2, ByVal catName)
        Dim layerCategory As Layer.Category
        Dim i As Integer
        Dim intArray(range2 - range1) As Integer
        For i = 0 To range2 - range1
            intArray(i) = range1 + i
        Next i

        Dim catDesc As String
        catDesc = CType(range1, String) + "-" + CType(range2, String)
        If Not CategoryExists(catName) Then
            layerCategory = WP.LayerCategories.CreateCategory(catName, catDesc, intArray)
        End If
    End Sub


    Function CategoryExists(ByVal categoryName As String) As Boolean
        Try
            Return Not WP.LayerCategories.FindObject(categoryName) Is Nothing
        Catch ex As Exception
            Return False
        End Try
    End Function


    Public Function GetUnloadOption(ByVal dummy As String) As Integer

        'Unloads the image immediately after execution within NX
        GetUnloadOption = NXOpen.Session.LibraryUnloadOption.Immediately


    End Function


    Public Function FileNameo(ByVal WithPath As String)

        Dim sWithoutPath As String
        Dim iLen As Integer
        Dim iWhere As Integer

        sWithoutPath = WithPath
        Do Until InStr(sWithoutPath, "\") = 0
            iLen = Len(sWithoutPath)
            iWhere = InStr(sWithoutPath, "\")
            sWithoutPath = Right(sWithoutPath, iLen - iWhere)
        Loop
        FileNameo = sWithoutPath

    End Function

End Module