' CREATION QUADRILLAGE LIGNE AUTO SUR VUES EN PLAN

Option Explicit

Dim drawingDocument As drawingDocument
Dim drawingWindow As Window
Dim drawingSheets As drawingSheets
Dim drawingSheet As drawingSheet
Dim drawingViews As drawingViews
Dim drawingView As drawingView
Dim tempDetailSheet As drawingSheet
Dim netDetailSheet As drawingSheet
Dim netDetail As drawingView
Dim spaceWindow As Window
Dim linkedProducts() As Object
Dim linkedDocument As document
Dim I As Integer
Dim J As Integer
Dim msgInput As String
Dim inputString As String
Dim inputBoolean As Boolean
Dim sFilter()
Dim iStatus As String
Dim iSel 'As Selection
Dim goExit As Boolean
Dim List() As Variant
Dim L As Integer
Dim roundTolerance As Double
Dim debugMode As Boolean
Dim netColorString As String
Dim inputTextDistH As Double
Dim inputTextDistV As Double
Dim netColorName As String
Dim netColor() As String
Dim netRed As Long
Dim netGreen As Long
Dim netBlue As Long
Dim textPrefix As String
Dim raster As Integer
Dim textPosH As String
Dim textPosV As String
Dim textFontSize As Double
Dim textDistH As Double
Dim textDistV As Double
Dim descriptionH As String
Dim descriptionV As String
Dim description() As String
Dim firstRun As String
Dim gridStandards()
Dim noNetCreate As Boolean
Const PI = 3.14159265358979



Sub CATMain()

    goExit = False
    debugMode = False
    roundTolerance = 1000000
    noNetCreate = False
    
    If firstRun <> "no" Then
        If TypeName(CATIA.ActiveDocument) = "DrawingDocument" Then
            'VALEURS QUADRILLAGE PAR DEFAUT
            ReDim netColor(2)
            netColor(0) = "16"
            netColor(1) = "3"
            netColor(2) = "67"
            textPrefix = "ACTSquad_"
            raster = 100
            textPosH = "G" 'Gauche
            textPosV = "B" 'Bas
            textFontSize = 7.5
            textDistH = 2.5 * textFontSize
            textDistV = 1 * textFontSize
            goExit = False
        Else
            goExit = True
        End If
        
        If goExit Then
            MsgBox "Mauvais type de document ou aucun document chargé" & vbLf & vbLf & _
                    "Script arrété", vbOKOnly + vbCritical, "   Cancel   "
            goExit = True
            Exit Sub
        End If
        
        Set drawingDocument = CATIA.ActiveDocument
        Set drawingWindow = CATIA.ActiveWindow
        Set drawingSheets = drawingDocument.Sheets
        Set drawingSheet = drawingSheets.ActiveSheet
        Set drawingViews = drawingSheet.Views
        
        Set drawingView = drawingViews.ActiveView
        drawingWindow.ActiveViewer.Viewpoint2D.PutOrigin Array(drawingView.x, drawingView.Y)
        
        msgInput = MsgBox("Créer/modifier/supprimmer le quadrillage  '" & drawingView.name & "' " & vbLf & vbLf & _
                            "dans l'onglet  '" & drawingSheet.name & "'  ?", _
                            vbYesNoCancel + vbQuestion, "   View to Process   ")
    Else
        msgInput = vbNo
    End If
    
    If msgInput = vbNo Then
        'Selection de la vue
        Set iSel = CATIA.ActiveDocument.Selection
        iSel.Clear
        ReDim sFilter(0)
        sFilter(0) = "DrawingView"
        msgInput = MsgBox("Sélectionner une vue pour appliquer le quadrillage" & vbLf & vbLf & _
                            "(Si la vue est dans une autre feuille, sélectionnez la dans l'arborescence)", _
                            vbOKOnly, "   Sélection de la vue   ")
        iStatus = iSel.SelectElement2(sFilter, "Select view", False)
        If (iStatus = "Cancel") Then
            MsgBox "Mauvaise sélection (par exemple, changement de feuille) ou annulation" & vbLf & vbLf & _
                    "Script arrété", vbOKOnly + vbCritical, "   Cancel   "
            Exit Sub
        End If
        Set drawingView = iSelItem(1).Value
        iSel.Clear
        drawingView.Activate
        Set drawingSheet = drawingView.Parent.Parent
        drawingSheet.Activate
    ElseIf msgInput <> vbYes Then
        Exit Sub
    End If
    
    If drawingView.IsGenerative Then
        If drawingView.LockStatus Then
            MsgBox "La vue sélectionnée est verouillée" & vbLf & vbLf & _
                "Impossible d'appliquer le quadrillage", vbOKOnly + vbCritical, "   VUE VEROUILLÉE   "
            noNetCreate = True
        Else
            'Quadrillage dans Vue? (Layer: 256)
            Dim ACTSquadExist As Boolean
            Dim ACTSquadDelete As Boolean
            Dim transferList()
            Dim transferListCount As Integer
            Set iSel = CATIA.ActiveDocument.Selection
            iSel.Clear
            iSel.Add drawingView
            iSel.Search ("Name=" & textPrefix & "*,sel")
            If iSelCount > 0 Then
                iSel.VisProperties.SetPick catVisPropertyNoPickAttr
                msgInput = MsgBox("Quadrillage trouvé" & vbLf & vbLf & _
                                    "Suppression du quadrillage" _
                                    , vbYesNo + vbQuestion, "   Suppression quadrillage ")
                If msgInput = vbYes Then
                    iSel.Cut
                    iSel.Clear
                    firstRun = "no"
                    msgInput = MsgBox("Quadrillage supprimmé" & vbLf & vbLf & _
                                        "Créer/modifier/supprimmer un autre quadrillage sur une autre vue" _
                                        , vbYesNo + vbQuestion, "   Continuer ou arrêter ")
                    If msgInput = vbYes Then CATMain
                    goExit = True
                    Exit Sub
                Else
                    iSel.Clear
                    ACTSquadExist = True
                End If
            Else
                iSel.Clear
                ACTSquadExist = False
            End If
            
            Dim viewFirstVector(2) As Variant 'Double
            Dim viewSecondVector(2) As Variant 'Double
            Dim viewNormalVector(2) As Variant 'Double
            
            Dim linkedProductsCount As Integer
            'Appel de fonction Parts Products
            SearchLinkedDocuments drawingView, viewFirstVector, viewSecondVector, viewNormalVector, linkedProducts, linkedProductsCount
             
            drawingWindow.Activate
            drawingDocument.Activate
            
            If goExit Then Exit Sub
            
            Dim netAngle(2) As Double
            Dim netLines As Integer
            Dim netInvert As Double
            
            netLines = 0
            netInvert = 1
            
            I = 0
            For I = 0 To 2
                If viewNormalVector(I) = 0 Then
                    netLines = netLines + 1
                    If viewFirstVector(I) = 0 Then
                        If viewSecondVector(I) < 0 Then
                            netAngle(I) = PI * 3 / 2
                        Else
                            netAngle(I) = PI / 2
                        End If
                    Else
                        netAngle(I) = Atn(viewSecondVector(I) / viewFirstVector(I))
                    End If
                    
                    If viewFirstVector(I) > 0 And viewSecondVector(I) < 0 Then
                        netAngle(I) = (2 * PI) + netAngle(I)
                    ElseIf viewFirstVector(I) < 0 Then
                        netAngle(I) = PI + netAngle(I)
                    End If
                Else
                    If viewNormalVector(I) = -1 Then
                        netInvert = -1
                    End If
                    netAngle(I) = 361
                End If
            Next
        End If
    Else
        MsgBox "La vue n'à pas de lien 3D" & vbLf & vbLf & _
                "Quadrillage impossible", vbOKOnly + vbCritical, "   No NET   "
        noNetCreate = True
    End If
    
    If noNetCreate Then
        'Validation orientation vue
    ElseIf netLines = 0 Then
        MsgBox "La vue sélectionnée n'est pas normale à l'un des plans" & vbLf & vbLf & _
                "Quadrillage impossible", vbOKOnly + vbCritical, "   Quadrillage impossible   "
    Else
        'Modification du standard
        ReDim gridStandards(8)
        gridStandards(0) = netColor(0)
        gridStandards(1) = netColor(1)
        gridStandards(2) = netColor(2)
        gridStandards(3) = raster
        gridStandards(4) = textPosH
        gridStandards(5) = textPosV
        gridStandards(6) = textFontSize
        gridStandards(7) = textDistH
        gridStandards(8) = textDistV
        
        SetStandards gridStandards
        
        If goExit Then Exit Sub
        
        netColor(0) = gridStandards(0)
        netColor(1) = gridStandards(1)
        netColor(2) = gridStandards(2)
        raster = gridStandards(3)
        textPosH = gridStandards(4)
        textPosV = gridStandards(5)
        textFontSize = gridStandards(6)
        textDistH = gridStandards(7)
        textDistV = gridStandards(8)
        
        If goExit Then Exit Sub
        
        'Creation/Modification quadrillage
        Dim indicateObject As Object
        Dim drawingWindowLocation(1)
        Dim first2DCoord(1)
        Dim second2DCoord(1)
        Dim createNetFirst As Boolean
        Dim createNetEnd As Boolean
        Dim first2DCoordAbs(1)
        Dim second2DCoordAbs(1)
        Dim trafoMatrix(3)
        Dim componentAngle As Double
        Dim netInvertInfo
        
        Set indicateObject = drawingDocument
        createNetFirst = True
        createNetEnd = False
        
        
        'Indication points extremes
        Do Until createNetEnd = True
            
            Set iSel = CATIA.ActiveDocument.Selection
            
            drawingSheet.Activate
            drawingView.Activate
            
            drawingWindow.ActiveViewer.Viewpoint2D.PutOrigin Array(drawingView.x, drawingView.Y)
                        
            MsgBox "Définir le dimensionnement du quadrillage en indiquant" & vbLf & _
                    "2 points à l'extérieur du cadre" & vbLf & vbLf & _
                    "Cliquer par exemple 1 fois en haut à gauche et 1 fois en bas à droite de la vue", vbOKOnly, "   2 POINTS   "
            
            iStatus = indicateObject.Indicate2D("1 ER point", drawingWindowLocation)
            If (iStatus = "Cancel") Then
                MsgBox "Mauvaise indication ou Annuler" & vbLf & vbLf & _
                        "Script arrété", vbOKOnly + vbCritical, "   ANNULER   "
                Exit Sub
            End If
            
            first2DCoord(0) = drawingWindowLocation(0)
            first2DCoord(1) = drawingWindowLocation(1)
            
            iStatus = indicateObject.Indicate2D("Indicate the second location into the drawing window", drawingWindowLocation)
            If (iStatus = "Cancel") Then
                MsgBox "Mauvaise indication ou Annuler" & vbLf & vbLf & _
                        "Script arrété", vbOKOnly + vbCritical, "   ANNULER    "
                Exit Sub
            End If
            
            second2DCoord(0) = drawingWindowLocation(0)
            second2DCoord(1) = drawingWindowLocation(1)
            
            ReDim description(2)
            description(0) = "X"
            description(1) = "Y"
            description(2) = "Z"
            descriptionH = ""
            descriptionV = ""
            
            If netLines = 2 Then
                If netAngle(0) = 361 Then
                    componentAngle = netAngle(1)
                    descriptionH = description(1)
                    descriptionV = description(2)
                ElseIf netAngle(1) = 361 Then
                    componentAngle = netAngle(2)
                    descriptionH = description(2)
                    descriptionV = description(0)
                ElseIf netAngle(2) = 361 Then
                    componentAngle = netAngle(0)
                    descriptionH = description(0)
                    descriptionV = description(1)
                End If
            ElseIf netLines = 1 Then
                I = 0
                For I = 0 To 2
                    If netAngle(I) < 361 Then
                        descriptionH = description(I)
                        descriptionV = ""
                        componentAngle = netAngle(I)
                        Exit For
                    End If
                Next
            End If
            
            first2DCoordAbs(0) = first2DCoord(0) * Cos(componentAngle) + first2DCoord(1) * Sin(componentAngle)
            first2DCoordAbs(1) = -first2DCoord(0) * Sin(componentAngle) + first2DCoord(1) * Cos(componentAngle)
            second2DCoordAbs(0) = second2DCoord(0) * Cos(componentAngle) + second2DCoord(1) * Sin(componentAngle)
            second2DCoordAbs(1) = -second2DCoord(0) * Sin(componentAngle) + second2DCoord(1) * Cos(componentAngle)
            
            If netLines = 2 Then
                first2DCoordAbs(1) = first2DCoordAbs(1) * netInvert
                second2DCoordAbs(1) = second2DCoordAbs(1) * netInvert
            End If
            
            Set drawingView = drawingViews.ActiveView
            
            If ACTSquadExist Then
                iSel.Add drawingView
                iSel.Search ("(Name=" & textPrefix & "*) + (Name='netDetail_*'),sel")
                iSel.Cut
                iSel.Clear
            End If
            
            If createNetFirst = False Then drawingSheets.Remove netDetailSheet.name
            
            Set netDetailSheet = drawingSheets.AddDetail("Quadrillage")
            Set netDetail = netDetailSheet.Views.Add("netDetail_" & drawingSheet.name & "_" & drawingView.name)
            
            netDetailSheet.[Scale] = 1
            netDetail.[Scale2] = 1
            
            netDetail.Activate
            
            NetDetailCreate first2DCoordAbs, second2DCoordAbs, componentAngle, netLines, netInvert
            
            drawingSheet.Activate
            drawingView.Activate
            
            'Insertion Informations
            drawingView.Components.Add netDetail, 0, 0
            drawingView.Components.Item(drawingView.Components.Count).Angle = componentAngle
            If netInvert = -1 Then
                drawingView.Components.Item(drawingView.Components.Count).Flip
                netInvertInfo = "(L'angle des textes peut être différent de la position finale)"
            Else
                netInvertInfo = ""
            End If
            
            iSel.Clear
            iSel.Add drawingView.Components.Item(drawingView.Components.Count)
            iSel.VisProperties.SetVisibleColor CLng(netColor(0)), CLng(netColor(1)), CLng(netColor(2)), 1
            iSel.VisProperties.SetVisibleWidth 1, 1
            iSel.VisProperties.SetPick catVisPropertyNoPickAttr
            iSel.Clear
            
            drawingWindow.ActiveViewer.Viewpoint2D.PutOrigin Array(drawingView.x, drawingView.Y)
            'Validation quadrillage
            msgInput = MsgBox("Le quadrillage est il OK" & vbLf & vbLf & netInvertInfo _
                                , vbYesNo + vbQuestion, "   Quadrillage OK   ")
            If msgInput = vbNo Then
                createNetEnd = False
                createNetFirst = False
            Else
                createNetEnd = True
            End If
            
        Loop
            
        drawingView.Components.Item(drawingView.Components.Count).Explode
        iSel.Clear
        iSel.Add drawingView.Components.Item(drawingView.Components.Count)
        iSel.Cut
        iSel.Clear
        drawingSheets.Remove netDetailSheet.name
        
        drawingView.Activate
        drawingSheet.Activate
        
    End If
        
    firstRun = "no"
    msgInput = MsgBox("Creation/modification/suppression du quadrillage terminé" & vbLf & vbLf & _
                        "Relancer le script" _
                        , vbYesNo + vbQuestion, "   Continuer ou arrêter ")
    If msgInput = vbYes Then CATMain
    
    If goExit Then Exit Sub
    
    firstRun = ""

End Sub


'Infos sur vue
'       Inputs:  -drawingView
'       Outputs: -viewFirstVector (Array of 1,2,3)
'                -viewSecondVector (Array of 1,2,3)
'                -viewNormalVector (Array of 1,2,3)
'                -linkedProducts (Array of 1,...,I)
'                -I (Nombre de quadrillages Products)
Public Function SearchLinkedDocuments(ByVal drawingView, ByRef viewFirstVector, ByRef viewSecondVector, _
                                        ByRef viewNormalVector, ByRef linkedProducts, ByRef I) 'ByRef/ByVal???
    
    Dim linkedProduct As Product
    Dim linkedDocumentExist As String
    linkedDocumentExist = "1"
    
    On Error Resume Next
    Set linkedProduct = drawingView.GenerativeBehavior.document
    If Err = -2147418113 Or linkedProduct Is Nothing Then
        linkedDocumentExist = "0"
    End If
    On Error GoTo 0
    
    If linkedDocumentExist = "0" Then
        MsgBox "Lien Part/Product non chargé" & vbLf & vbLf & _
                "Script arrêté", vbOKOnly + vbCritical, "   ANNULER   "
        goExit = True
        Exit Function
    End If
    
    Set linkedDocument = drawingView.GenerativeBehavior.document.ReferenceProduct.Parent
    
    'Recherche des documents parents/enfants
    Dim linkedDocumentParent As Object
    Dim linkedDocumentParentParent As Object
    
    Set linkedDocumentParent = linkedProduct.Parent
    Set linkedDocumentParentParent = linkedDocumentParent.Parent
    
    Do Until TypeName(linkedDocumentParentParent) = "Application"
        Set linkedDocumentParent = linkedDocumentParentParent
        Set linkedDocumentParentParent = linkedDocumentParent.Parent
    Loop
    
    Set linkedDocument = linkedDocumentParent
    
    'MsgBox linkedDocument.name
    
    Dim linkedDocumentOpened As Boolean
    linkedDocumentOpened = False
    I = 1
    For I = 1 To CATIA.Windows.Count
        If CATIA.Windows.Item(I).name = linkedDocument.name Then
            linkedDocumentOpened = True
            Set spaceWindow = CATIA.Windows.Item(I)
            Exit For
        End If
    Next
    
    If (Not linkedDocumentOpened) Then
        CATIA.Documents.Open (linkedDocument.FullName)
        Set spaceWindow = CATIA.ActiveWindow
    End If
    
    'Axe de référence dans le système 3D
    Dim oProduct As Variant
    Dim oAxis As Variant
    
    
    ReDim linkedProducts(1)
    Set linkedProducts(1) = drawingView.GenerativeLinks.FirstLink
    
    Dim moreLinks As Boolean
    moreLinks = True
    Dim tabString As String
    tabString = linkedProducts(1).name & vbLf
    
    I = 2
    
    Do Until moreLinks = False
        
        On Error Resume Next
        ReDim Preserve linkedProducts(I)
        Set linkedProducts(I) = drawingView.GenerativeLinks.NextLink()
        If Err = 0 Then
            On Error GoTo 0
            tabString = tabString & linkedProducts(I).name & vbLf
            I = I + 1
        Else
            On Error GoTo 0
            I = I - 1
            ReDim Preserve linkedProducts(I)
            moreLinks = False
        End If
        
    Loop
    
    'Zero vue - Axe 3D
    Dim axisReferenceProduct As Product
    
    Dim oViewFirstVector(2) As Variant 'Double
    Dim oViewSecondVector(2) As Variant 'Double
    Dim oViewNormalVector(2) As Variant 'Double
    
    drawingView.GenerativeBehavior.GetProjectionPlane oViewFirstVector(0), oViewFirstVector(1), oViewFirstVector(2), _
                                                        oViewSecondVector(0), oViewSecondVector(1), oViewSecondVector(2)
    
    drawingView.GenerativeBehavior.GetProjectionPlaneNormal oViewNormalVector(0), oViewNormalVector(1), oViewNormalVector(2)
    
    
    If I = 1 Then
        Set axisReferenceProduct = linkedDocument.Product
    Else
        Set axisReferenceProduct = drawingView.GenerativeBehavior.document
        
        'Calcul valeur absolue des vecteurs de la vue
        Dim iVector As Variant
        Dim absoluteMatrix(11) As Variant
        
        GetAbsoluteCoordinates axisReferenceProduct, linkedDocument.Product, absoluteMatrix
        
        iVector = oViewFirstVector
        oViewFirstVector(0) = iVector(0) * absoluteMatrix(0) + iVector(1) * absoluteMatrix(3) + iVector(2) * absoluteMatrix(6)
        oViewFirstVector(1) = iVector(0) * absoluteMatrix(1) + iVector(1) * absoluteMatrix(4) + iVector(2) * absoluteMatrix(7)
        oViewFirstVector(2) = iVector(0) * absoluteMatrix(2) + iVector(1) * absoluteMatrix(5) + iVector(2) * absoluteMatrix(8)
        
        iVector = oViewSecondVector
        oViewSecondVector(0) = iVector(0) * absoluteMatrix(0) + iVector(1) * absoluteMatrix(3) + iVector(2) * absoluteMatrix(6)
        oViewSecondVector(1) = iVector(0) * absoluteMatrix(1) + iVector(1) * absoluteMatrix(4) + iVector(2) * absoluteMatrix(7)
        oViewSecondVector(2) = iVector(0) * absoluteMatrix(2) + iVector(1) * absoluteMatrix(5) + iVector(2) * absoluteMatrix(8)
        
        iVector = oViewNormalVector
        oViewNormalVector(0) = iVector(0) * absoluteMatrix(0) + iVector(1) * absoluteMatrix(3) + iVector(2) * absoluteMatrix(6)
        oViewNormalVector(1) = iVector(0) * absoluteMatrix(1) + iVector(1) * absoluteMatrix(4) + iVector(2) * absoluteMatrix(7)
        oViewNormalVector(2) = iVector(0) * absoluteMatrix(2) + iVector(1) * absoluteMatrix(5) + iVector(2) * absoluteMatrix(8)
        
    End If
    
    RoundVector oViewFirstVector, roundTolerance, viewFirstVector
    RoundVector oViewSecondVector, roundTolerance, viewSecondVector
    RoundVector oViewNormalVector, roundTolerance, viewNormalVector
    
    If debugMode Then
        MsgBox "Lien vers document:  " & linkedDocument.name & vbLf & vbLf & _
                "Premier lien :  " & drawingView.GenerativeBehavior.document.name & vbLf & vbLf & _
                "Orientation:  " & axisReferenceProduct.name & vbLf & vbLf & _
                "Premier vecteur:  " & viewFirstVector(0) & " ; " & viewFirstVector(1) & " ; " & viewFirstVector(2) & vbLf & vbLf & _
                "Second vecteur:  " & viewSecondVector(0) & " ; " & viewSecondVector(1) & " ; " & viewSecondVector(2) & vbLf & vbLf & _
                "Vecteur Normal:  " & viewNormalVector(0) & " ; " & viewNormalVector(1) & " ; " & viewNormalVector(2)
    End If
    
End Function


'Déterminer les coordonnées absolues d'un point / vecteur
'       Inputs:  -Object(Parent) Points/Vecteurs
'                -Type d'Objects ("trou", "point", "vecteur")
'       Outputs: -Point/Vecteur Absolu(Array(2))
Public Sub GetAbsolutePointCoordinates(ByVal iObject, ByVal insideProduct, ByVal oType, ByRef absPoint)

    Dim rootProduct As Product
    Set rootProduct = CATIA.ActiveDocument.Product
    
    Dim pointInPart(2)
    
    Select Case LCase(oType)
        
        Case "hole"
            iObject.GetOrigin pointInPart
            
        Case "point"
            iObject.GetCoordinates pointInPart
            
        Case "vector"
            iObject.GetDirection pointInPart
            
        Case "product"
            pointInPart(0) = 0
            pointInPart(1) = 0
            pointInPart(2) = 0
        
        Case Else
            Exit Sub
        
    End Select
    
    Dim absoluteMatrix(11) As Variant
    
    GetAbsoluteCoordinates insideProduct, rootProduct, absoluteMatrix
    
    absPoint(0) = pointInPart(0) * absoluteMatrix(0) + pointInPart(1) * absoluteMatrix(3) + pointInPart(2) * absoluteMatrix(6) + absoluteMatrix(9)
    absPoint(1) = pointInPart(0) * absoluteMatrix(1) + pointInPart(1) * absoluteMatrix(4) + pointInPart(2) * absoluteMatrix(7) + absoluteMatrix(10)
    absPoint(2) = pointInPart(0) * absoluteMatrix(2) + pointInPart(1) * absoluteMatrix(5) + pointInPart(2) * absoluteMatrix(8) + absoluteMatrix(11)
    
    If LCase(oType) = "vector" Then
        
        absPoint(0) = pointInPart(0) * absoluteMatrix(0) + pointInPart(1) * absoluteMatrix(3) + pointInPart(2) * absoluteMatrix(6)
        absPoint(1) = pointInPart(0) * absoluteMatrix(1) + pointInPart(1) * absoluteMatrix(4) + pointInPart(2) * absoluteMatrix(7)
        absPoint(2) = pointInPart(0) * absoluteMatrix(2) + pointInPart(1) * absoluteMatrix(5) + pointInPart(2) * absoluteMatrix(8)
        
    End If
    
    
    'MsgBox absPoint(0) & ";" & absPoint(1) & ";" & absPoint(2)
    
End Sub


'Multiplication des matrices (Attention à l'ordre de saisie)
Public Function MatrixProduct(ByVal matrix1, ByVal matrix2, ByRef c) 'matrix3)
    
    Dim a 'As Variant
    Dim b 'As Variant
    
    a = matrix1
    b = matrix2
   
    c(0) = a(0) * b(0) + a(1) * b(3) + a(2) * b(6)
    c(3) = a(3) * b(0) + a(4) * b(3) + a(5) * b(6)
    c(6) = a(6) * b(0) + a(7) * b(3) + a(8) * b(6)
    c(1) = a(0) * b(1) + a(1) * b(4) + a(2) * b(7)
    c(4) = a(3) * b(1) + a(4) * b(4) + a(5) * b(7)
    c(7) = a(6) * b(1) + a(7) * b(4) + a(8) * b(7)
    c(2) = a(0) * b(2) + a(1) * b(5) + a(2) * b(8)
    c(5) = a(3) * b(2) + a(4) * b(5) + a(5) * b(8)
    c(8) = a(6) * b(2) + a(7) * b(5) + a(8) * b(8)
    c(9) = a(9) * b(0) + a(10) * b(3) + a(11) * b(6) + b(9)
    c(10) = a(9) * b(1) + a(10) * b(4) + a(11) * b(7) + b(10)
    c(11) = a(9) * b(2) + a(10) * b(5) + a(11) * b(8) + b(11)
    
    
End Function


'Détermination de la position d'un absolu Products
'       Inputs:  -Product, de la position déterminée (subProduct)
'                -Product, à la position déterminée (activeProduct)
'       Outputs: -Matrice de transformation entre sous-produit et produit parent
Public Function GetAbsoluteCoordinates(ByVal subProduct, ByVal activeProduct, ByRef coordMatrix)

  'Dim coordMatrix(11)
  If (subProduct.name = activeProduct.name) Then
    coordMatrix(0) = 1
    coordMatrix(1) = 0
    coordMatrix(2) = 0
    coordMatrix(3) = 0
    coordMatrix(4) = 1
    coordMatrix(5) = 0
    coordMatrix(6) = 0
    coordMatrix(7) = 0
    coordMatrix(8) = 1
    coordMatrix(9) = 0
    coordMatrix(10) = 0
    coordMatrix(11) = 0
  Else
    Dim relativPosition(11) As Variant
    Dim absolutePosition(11) As Variant
    subProduct.position.GetComponents relativPosition
    GetAbsoluteCoordinates subProduct.Parent.Parent, activeProduct, absolutePosition
    MatrixProduct relativPosition, absolutePosition, coordMatrix
  End If

End Function


'Modification précision vecteur via une tolérance prédéfinie
Public Function RoundVector(ByVal iVector, ByVal roundTolerance, ByRef oVector)
    
    'Dim roundVector(2)
    
    oVector(0) = Round(iVector(0) * roundTolerance, 0) / roundTolerance
    oVector(1) = Round(iVector(1) * roundTolerance, 0) / roundTolerance
    oVector(2) = Round(iVector(2) * roundTolerance, 0) / roundTolerance

End Function


'Inversion de matrice
Public Function MatrixInverse(ByVal matrix, ByRef inverse)

  Dim a(11)
  Dim I As Integer
  For I = 0 To 11
    a(I) = matrix(I)
  Next
  
  inverse(0) = a(4) * a(8) - a(7) * a(5)
  inverse(1) = a(2) * a(7) - a(8) * a(1)
  inverse(2) = a(1) * a(5) - a(4) * a(2)
  inverse(3) = a(5) * a(6) - a(8) * a(3)
  inverse(4) = a(0) * a(8) - a(6) * a(2)
  inverse(5) = a(2) * a(3) - a(5) * a(0)
  inverse(6) = a(3) * a(7) - a(6) * a(4)
  inverse(7) = a(1) * a(6) - a(7) * a(0)
  inverse(8) = a(0) * a(4) - a(1) * a(3)
  inverse(9) = -(a(9) * inverse(0) + a(10) * inverse(3) + a(11) * inverse(6))
  inverse(10) = -(a(9) * inverse(1) + a(10) * inverse(4) + a(11) * inverse(7))
  inverse(11) = -(a(9) * inverse(2) + a(10) * inverse(5) + a(11) * inverse(8))

End Function


'Définition du degré de précision
Public Function CorrectDecimal(ByRef doubleParam As String) As String
    
    If (Not ((InStr(doubleParam, ".") > 0 Or InStr(doubleParam, ",") > 0) And (InStr(CStr(CDbl(doubleParam)), ".") > 0 Or InStr(CStr(CDbl(doubleParam)), ",") > 0))) Then
        doubleParam = Replace(doubleParam, ",", ".")
        If (Not ((InStr(doubleParam, ".") > 0 Or InStr(doubleParam, ",") > 0) And (InStr(CStr(CDbl(doubleParam)), ".") > 0 Or InStr(CStr(CDbl(doubleParam)), ",") > 0))) Then
            doubleParam = Replace(doubleParam, ".", ",")
        End If
    End If
    
    CorrectDecimal = doubleParam
    
End Function


'Création des informations liées à la vue active
Public Function NetDetailCreate(ByVal first2DCoordAbs, ByVal second2DCoordAbs, ByVal componentAngle, ByVal netLines, ByVal netInvert)
    
    Dim minSelH As Double
    Dim minSelV As Double
    Dim maxSelH As Double
    Dim maxSelV As Double
    Dim minH As Double
    Dim minV As Double
    Dim maxH As Double
    Dim maxV As Double
    
    If first2DCoordAbs(0) < second2DCoordAbs(0) Then
        minSelH = first2DCoordAbs(0)
        maxSelH = second2DCoordAbs(0)
    Else
        maxSelH = first2DCoordAbs(0)
        minSelH = second2DCoordAbs(0)
    End If
    
    If first2DCoordAbs(1) < second2DCoordAbs(1) Then
        minSelV = first2DCoordAbs(1)
        maxSelV = second2DCoordAbs(1)
    Else
        maxSelV = first2DCoordAbs(1)
        minSelV = second2DCoordAbs(1)
    End If
    
    
    minH = (Fix(minSelH / raster) - 0.5 + (Sgn(minSelH) * 0.5)) * raster
    maxH = (Fix(maxSelH / raster) + 0.5 + (Sgn(maxSelH) * 0.5)) * raster
    minV = (Fix(minSelV / raster) - 0.5 + (Sgn(minSelV) * 0.5)) * raster
    maxV = (Fix(maxSelV / raster) + 0.5 + (Sgn(maxSelV) * 0.5)) * raster
        
    Dim drawingTexts As drawingTexts
    Dim drawingText As drawingText
    Dim LMC As Currency
    Dim textPosAngle As Double
    
    Set drawingTexts = netDetail.Texts
    textPosAngle = componentAngle + drawingView.Angle
    textPosAngle = textPosAngle - Fix((textPosAngle / (2 * PI)))
    
    Dim posH As Double
    Dim posV As Double
    Dim netLineAngle As Double
    
    
    If (textPosAngle < (PI / 4)) Or (textPosAngle > (PI * 7 / 4)) Then
        netLineAngle = 0
        If (textPosH = "G") Then
            posH = (minH - (raster / 5)) - (textDistH / drawingView.Scale2)
        ElseIf (textPosH = "D") Then
            posH = (maxH + (raster / 5)) + (textDistH / drawingView.Scale2)
        End If
        
        If (textPosV = "B") Then
            If netInvert = -1 Then
                posV = (maxV + (raster / 5)) + (textDistV / drawingView.Scale2)
            Else
                posV = (minV - (raster / 5)) - (textDistV / drawingView.Scale2)
            End If
        ElseIf (textPosV = "H") Then
            If netInvert = -1 Then
                posV = (minV - (raster / 5)) - (textDistV / drawingView.Scale2)
            Else
                posV = (maxV + (raster / 5)) + (textDistV / drawingView.Scale2)
            End If
        End If
    ElseIf (textPosAngle < (PI * 3 / 4)) Then
        netLineAngle = -(PI / 2)
        If (textPosV = "H") Then
            posH = (maxH + (raster / 5)) + (textDistV / drawingView.Scale2)
        ElseIf (textPosV = "B") Then
            posH = (minH - (raster / 5)) - (textDistV / drawingView.Scale2)
        End If
        
        If (textPosH = "G") Then
            If netInvert = -1 Then
                posV = (minV - (raster / 5)) - (textDistH / drawingView.Scale2)
            Else
                posV = (maxV + (raster / 5)) + (textDistH / drawingView.Scale2)
            End If
        ElseIf (textPosH = "D") Then
            If netInvert = -1 Then
                posV = (maxV + (raster / 5)) + (textDistH / drawingView.Scale2)
            Else
                posV = (minV - (raster / 5)) - (textDistH / drawingView.Scale2)
            End If
        End If
    ElseIf (textPosAngle < (PI * 5 / 4)) Then
        netLineAngle = -PI
        If (textPosH = "D") Then
            posH = (minH - (raster / 5)) - (textDistH / drawingView.Scale2)
        ElseIf (textPosH = "G") Then
            posH = (maxH + (raster / 5)) + (textDistH / drawingView.Scale2)
        End If
        
        If (textPosV = "H") Then
            If netInvert = -1 Then
                posV = (maxV + (raster / 5)) + (textDistV / drawingView.Scale2)
            Else
                posV = (minV - (raster / 5)) - (textDistV / drawingView.Scale2)
            End If
        ElseIf (textPosV = "B") Then
            If netInvert = -1 Then
                posV = (minV - (raster / 5)) - (textDistV / drawingView.Scale2)
            Else
                posV = (maxV + (raster / 5)) + (textDistV / drawingView.Scale2)
            End If
        End If
    Else
        netLineAngle = -(PI * 3 / 2)
        If (textPosV = "B") Then
            posH = (maxH + (raster / 5)) + (textDistV / drawingView.Scale2)
        ElseIf (textPosV = "H") Then
            posH = (minH - (raster / 5)) - (textDistV / drawingView.Scale2)
        End If
        
        If (textPosH = "D") Then
            If netInvert = -1 Then
                posV = (minV - (raster / 5)) - (textDistH / drawingView.Scale2)
            Else
                posV = (maxV + (raster / 5)) + (textDistH / drawingView.Scale2)
            End If
        ElseIf (textPosH = "G") Then
            If netInvert = -1 Then
                posV = (maxV + (raster / 5)) + (textDistH / drawingView.Scale2)
            Else
                posV = (minV - (raster / 5)) - (textDistH / drawingView.Scale2)
            End If
        End If
    End If
    
    For I = minH To maxH Step raster
        netDetail.Factory2D.CreateLine I, minV - (raster / 5), I, maxV + (raster / 5)
        Set drawingText = drawingTexts.Add(descriptionH & CStr(I), I, posV)
        drawingText.AnchorPosition = catMiddleCenter
        drawingText.SetFontSize 0, 0, textFontSize
        drawingText.Angle = ((textPosAngle + netLineAngle) * 180 / PI)
    Next
    
    If netLines = 2 Then
        For I = minV To maxV Step raster
            netDetail.Factory2D.CreateLine minH - (raster / 5), I, maxH + (raster / 5), I
            Set drawingText = drawingTexts.Add(descriptionV & CStr(I), posH, I)
            drawingText.AnchorPosition = catMiddleCenter
            drawingText.SetFontSize 0, 0, textFontSize
            drawingText.Angle = ((textPosAngle + netLineAngle) * 180 / PI)
        Next
    End If
    
    If debugMode Then
        netDetail.Factory2D.CreateLine first2DCoordAbs(0), first2DCoordAbs(1), first2DCoordAbs(0), second2DCoordAbs(1)
        netDetail.Factory2D.CreateLine first2DCoordAbs(0), second2DCoordAbs(1), second2DCoordAbs(0), second2DCoordAbs(1)
        netDetail.Factory2D.CreateLine second2DCoordAbs(0), second2DCoordAbs(1), second2DCoordAbs(0), first2DCoordAbs(1)
        netDetail.Factory2D.CreateLine second2DCoordAbs(0), first2DCoordAbs(1), first2DCoordAbs(0), first2DCoordAbs(1)
    End If
    
    I = 1
    For I = 1 To drawingTexts.Count
        drawingTexts.Item(I).name = textPrefix & drawingTexts.Item(I).name
    Next
    
    I = 1
    For I = 1 To netDetail.GeometricElements.Count
        netDetail.GeometricElements.Item(I).name = textPrefix & netDetail.GeometricElements.Item(I).name
    Next
    
End Function


'Entrée des parametres de routine
Public Function InputParameter(ByRef parmValue, ByVal parmName As String, ByVal requestInput As Boolean)
    
    'Dim inputString As String
    inputString = ""
    'Dim msgInput As String
    Do While inputString = ""
        'Case de configuration
        inputString = InputBox(parmName & " = ", "    Input   ", CStr(parmValue))
        If (inputString <> "") And (TypeName(parmValue) = "Double") Then
            On Error Resume Next
            inputString = CStr(CDbl(inputString))
            If Err <> 0 Then
                inputString = ""
            End If
            On Error GoTo 0
        ElseIf (inputString <> "") And (TypeName(parmValue) = "Integer") Then
            On Error Resume Next
            inputString = CStr(CInt(inputString))
            If Err <> 0 Then
                inputString = ""
            End If
            On Error GoTo 0
        ElseIf inputString <> "" Then
            If requestInput Then
                On Error Resume Next
                'Validation des données d'entrée
                msgInput = MsgBox("'" & parmName & "' = " & inputString & vbLf & vbLf & _
                                    "Entrée correct", vbYesNo + vbQuestion, "    VALEUR   ")
                On Error GoTo 0
                If msgInput = vbYes Then Exit Do
                inputString = ""
            End If
        Else
            msgInput = MsgBox("Vide ou annuler" & vbLf & vbLf & _
                            "Quitter le script", vbYesNo + vbExclamation, "   QUITTER   ")
            If msgInput = vbYes Then
                goExit = True
                Exit Do
            End If
            inputString = ""
        End If
    Loop
    
    If goExit Then Exit Function
    
    If TypeName(parmValue) = "String" Then
        parmValue = inputString
    Else
        
        parmValue = CorrectDecimal(inputString)
    End If
    
    InputParameter = parmValue
    
End Function


'Modification du Standard
Public Function SetStandards(ByRef standards)
    
    'Macro-Default du Standard
    ReDim netColor(2)
    netColor(0) = standards(0)
    netColor(1) = standards(1)
    netColor(2) = standards(2)
    raster = standards(3)
    textPosH = standards(4)
    textPosV = standards(5)
    textFontSize = standards(6)
    textDistH = standards(7)
    textDistV = standards(8)
    
    goExit = False
    
    'Modification du Standard
    msgInput = vbNo
    Do Until msgInput = vbYes
        If CLng(netColor(0)) = 16 And CLng(netColor(1)) = 3 And CLng(netColor(2)) = 67 Then
            netColorName = "ACTS-Default (greenblue)"
        Else
            netColorName = "User defined   (" & netColor(0) & "," & netColor(1) & "," & netColor(2) & ")"
        End If

        msgInput = MsgBox("Voulez vous utiliser les paramètres actuels" & vbLf & vbLf & _
                            "Espacement du quadrillage (mm) :  ' " & raster & " ' " & vbLf & _
                            "Texte horizontale Gauche/Droite :    ' "& textPosH & " ' " & vbLf & _
                            "Texte verticale Haut/Bas :                  ' "& textPosV & " ' " & vbLf & _
                            "Hauteur du texte (mm) :                    ' "& textFontSize & " ' ", _
                            vbYesNo + vbQuestion, "   PARAMÈTRES   ")

        If msgInput = vbNo Then
            'Saisie des nouvelles valeurs
            inputTextDistH = textDistH / textFontSize
            inputTextDistV = textDistV / textFontSize
            
            inputBoolean = False
            Do Until inputBoolean
                InputParameter raster, "Espacement (mm)", False
                If CStr(CInt(raster)) = raster And CInt(raster) > 0 Then
                    inputBoolean = True
                ElseIf goExit Then
                    Exit Do
                End If
            Loop
            If goExit Then Exit Do
            inputBoolean = False
            Do Until inputBoolean
            InputParameter textPosH, "Texte position horizontale (Gauche:G / Droite:D)", False
                'If (LCase(textPosH) = "G") Or (LCase(textPosH) = "D") Then : SI MOT = MINUSCULE
				If textPosH = "G" Or textPosH = "D" Then
                    inputBoolean = True
                ElseIf goExit Then
                    Exit Do
                End If
            Loop
            If goExit Then Exit Do
            inputBoolean = False
            Do Until inputBoolean
            InputParameter textPosV, "Texte position verticale (Haut:H /Bas:B)", False
                'If (LCase(textPosV) = "H") Or (LCase(textPosV) = "B") Then : SI MOT = MINUSCULE
				If textPosV = "H" Or textPosV = "B" Then
                    inputBoolean = True
                ElseIf goExit Then
                    Exit Do
                End If
            Loop
            If goExit Then Exit Do
            inputBoolean = False
            Do Until inputBoolean
            InputParameter textFontSize, "Hauteur du texte (mm)", False
                If CStr(CDbl(textFontSize)) = textFontSize Then
                    inputBoolean = True
                ElseIf goExit Then
                    Exit Do
                End If
            Loop
            If goExit Then Exit Do
            textDistH = inputTextDistH * textFontSize
            textDistV = inputTextDistV * textFontSize
            
        End If
    Loop
    
    If goExit Then Exit Function
    
    standards(0) = netColor(0)
    standards(1) = netColor(1)
    standards(2) = netColor(2)
    standards(3) = raster
    standards(4) = textPosH
    standards(5) = textPosV
    standards(6) = textFontSize
    standards(7) = textDistH
    standards(8) = textDistV

End Function


'Définition de la release pour Selection.Count/Count2
Public Function iSelCount()
    
    If CATIA.SystemConfiguration.Release >= "16" Then
        iSelCount = iSel.Count2
    Else
        iSelCount = iSel.Count
    End If
    
End Function


'Définition de la release pour Selection.Item/Item2
Public Function iSelItem(ByVal Num)
    
    If CATIA.SystemConfiguration.Release >= "16" Then
        Set iSelItem = iSel.Item2(Num)
    Else
        Set iSelItem = iSel.Item(Num)
    End If
    
End Function