Importation des points d'un profil d'aile à l'aide d'une macros Excel

Bonjour,
J'essaie d'importer les points d'un profil d'aile à partir d'excel en exécutant une macros. Le fichier excel avec lequel je travail est

GSD_PointSplineLoftFromExcel

Mais il me donne l'erreur suivante :  

Incompatibilité de type

Code:

StartLoft
StartCurve
0 100.005600 0.125900
0 99.852400 0.154300
0 99.393800 0.239100
0 98.632400 0.378800
0 97.572900 0.571100
0 96.221500 0.812800
0 94.586400 1.099900
0 92.677500 1.428000
0 90.506100 1.792200
0 88.085400 2.187100
0 85.430100 2.607300
0 82.556300 3.046800
0 79.481400 3.500100
0 76.224200 3.961100
0 72.804600 4.423900
0 69.243600 4.882600
0 65.562900 5.331000
0 61.785100 5.763000
0 57.933600 6.172300
0 54.032000 6.552700
0 50.104600 6.897900
0 46.175400 7.201800
0 42.269100 7.458400
0 38.409700 7.662200
0 34.621400 7.808200
0 30.927600 7.892200
0 27.351600 7.910700
0 23.915600 7.861500
0 20.641000 7.743500
0 17.548300 7.556900
0 14.656800 7.303000
0 11.984600 6.984400
0 9.466100 6.600100
0 6.931300 6.009100
0 4.789500 5.213000
0 3.046600 4.298000
0 1.698300 3.337800
0 0.734400 2.391400
0 0.141000 1.502900
0 -0.097900 0.701000
0 0.000000 0.000000
0 0.406100 -0.578700
0 1.090100 -1.025500
0 2.028600 -1.362600
0 3.196000 -1.619600
0 4.565500 -1.832600
0 6.109800 -2.041200
0 7.804700 -2.286200
0 9.632200 -2.608200
0 11.974800 -2.986300
0 14.632500 -3.313600
0 17.506900 -3.584900
0 20.580500 -3.799100
0 23.834600 -3.956600
0 27.249300 -4.058500
0 30.804000 -4.107200
0 34.476900 -4.105800
0 38.245800 -4.058500
0 42.087500 -3.969800
0 45.978600 -3.844600
0 49.895400 -3.688100
0 53.813900 -3.505400
0 57.709900 -3.301600
0 61.559400 -3.081500
0 65.338800 -2.849400
0 69.024800 -2.609400
0 72.594400 -2.365300
0 76.025600 -2.120400
0 79.297100 -1.877800
0 82.388500 -1.640500
0 85.280600 -1.411400
0 87.955200 -1.193200
0 90.395600 -0.988400
0 92.586600 -0.799900
0 94.514200 -0.630200
0 96.166400 -0.481600
0 97.532800 -0.356500
0 98.604600 -0.257000
0 99.375100 -0.184600
0 99.839300 -0.140600
0 99.994400 -0.125900
 
 
EndCurve
EndLoft
End


Cordialement.

Bonjour,

J'ai apportée quelques petites corrections dans la fonction "GetCATIAPart()"

Pour que la macro fonctionne, il faut avoir une Part active dans CATIA.

Code:

'------------------------------------------------------------------------
' Get CATIADocument
'------------------------------------------------------------------------
Function GetCATIAPart() As Object
    Set CATIA = GetCATIA
    
    Dim MyPart As Object
'*********** début correction: *******************
    'Set MyPart = CATIA.ActiveEditor.ActiveObject
    Set MyPartDoc = CATIA.Activedocument
    Set MyPart = MyPartDoc.Part
'************ fin correction *********************
    Set GetCATIAPart = MyPart
End Function

Merci @lumpazepfel pour votre réponse. Permettez moi de vous demander, car je suis un novice sur VBA, où est ce que je vais insérer ce code est ce que dans le fichier excel où il y a le code ci-haut ou dans l’Éditeur VBA ?

Cordialement.

Bonjour,

Oui le code a modifié se trouve dans l’éditeur VBA de Excel : cliquer sur (1)"Développeur" puis sur (2)"Visual Basic".
Ensuite dans l'éditeur VBA cliquer sur (3)"Déclarations" et rechercher (4) "GetCATIAPart" puis corriger la fonction comme indiqué dans mon message précédent.

Ce que vous avez posté ce n'est pas un code, ceux sont les valeurs que la macro va importer dans CATIA.
les lignes StartCurve et EndCurve permettent de séparer les valeurs pour créer des courbes différentes en une seule fois.
Attention, je pense qu'il ne faut pas laisser de ligne vide.

Bonjour,
j'ai suivi les étapes indiquées ci-dessus, mais le problème persiste toujours. Il indique le même message d'erreur "incompatibilité de type".
Le code par défaut que j'ai trouvé dans l'éditeur VBA est comme suite :

Code:


'------------------------------------------------------------------------
' Get CATIADocument
'------------------------------------------------------------------------
Function GetCATIAPartDocument() As Object
    Set CATIA = GetCATIA
    
    Dim MyPartDocument As Object
    Set MyPartDocument = CATIA.ActiveDocument
    
    Set GetCATIAPartDocument = MyPartDocument
End Function
'------------------------------------------------------------------------
' Creates all usable points from the parameter file
'----------------------------------------------------


J'ai essayé d'ajouter la fonction dans la ligne vide dans le code ci dessus :

Code:

Set MyPart = MyPartDocument.Part

mais sans succès. J'ai remarqué aussi que tu as mis la ligne ci-dessous en commentaire.

Code:

'Set MyPart = CATIA.ActiveEditor.ActiveObject

 
Cordialement.

Bonjour,

Poster le code en entier, ce sera plus facile pour le tester de mon coté.
Quelle est votre version de CATIA?

Bonjour,
J'ai la version V5R21 de Catia. Le code en entier est comme suite :

Code:

'//============================================================================
'// COPYRIGHT DASSAULT SYSTEMES 2001
'//============================================================================
'// Generative Shape Design
'// point, splines, loft generation tool
'//============================================================================
Const Cst_iSTARTCurve    As Integer = 1
Const Cst_iENDCurve      As Integer = 11
Const Cst_iSTARTLoft     As Integer = 2
Const Cst_iENDLoft       As Integer = 22
Const Cst_iSTARTCoord    As Integer = 3
Const Cst_iENDCoord      As Integer = 33
Const Cst_iERRORCool     As Integer = 99
Const Cst_iEND           As Integer = 9999

Const Cst_strSTARTCurve    As String = "StartCurve"
Const Cst_strENDCurve      As String = "EndCurve"
Const Cst_strSTARTLoft     As String = "StartLoft"
Const Cst_strENDLoft       As String = "EndLoft"
Const Cst_strSTARTCoord    As String = "StartCoord"
Const Cst_strENDCoord      As String = "EndCoord"
Const Cst_strEND           As String = "End"

'------------------------------------------------------------------------
'To define the kind of elements to create (1: create only points
'2: creates points and splines
'3: Creates points, splines and loft
'------------------------------------------------------------------------
Function GetTypeFile() As Integer
    Dim strInput As String, strMsg As String
    
    choice = 0
    While (choice < 1 Or choice > 3)
        strMsg = "Type in the kind of entities to create (1 for points, 2 for points and splines, 3 for points, splines and loft):"
        strInput = InputBox(Prompt:=strMsg, _
            Title:="User Info", XPos:=2000, YPos:=2000)
    
        'Validation of the choice
        choice = CInt(strInput)
        If (choice < 1 Or choice > 3) Then
            MsgBox "Invalid value: must be 1, 2 or 3"
        End If
    Wend
    GetTypeFile = choice
End Function

'------------------------------------------------------------------------
'Get the active cell
'------------------------------------------------------------------------
Function GetCell(iindex As Integer, column As Integer) As String
    Dim Chain As String
    
    Sheets("Feuil1").Select
    If (column = 1) Then
        Chain = "A" + CStr(iindex)
    ElseIf (column = 2) Then
        Chain = "B" + CStr(iindex)
    ElseIf (column = 3) Then
        Chain = "C" + CStr(iindex)
    End If
    Range(Chain).Select
    GetCell = ActiveCell.Value
End Function
Function GetCellA(iRang As Integer) As String
    GetCellA = GetCell(iRang, 1)
End Function
Function GetCellB(iRang As Integer) As String
    GetCellB = GetCell(iRang, 2)
End Function
Function GetCellC(iRang As Integer) As String
    GetCellC = GetCell(iRang, 3)
End Function
'------------------------------------------------------------------------
'Syntax of the parameter file
'------------------------
'StartCurve                 -> to start the list of points defining the spline
' double  ,  double  ,  double
' double  ,  double  ,  double      -> as many points as necessary to define the spline
'EndCurve                   -> to end the list of points defining the spline
'
'
'Example:
'--------
'StartCurve
' -10.89, 10 , 46.78
'1.56, 4, 6
'EndCurve  -> spline composed of 2 points
'------------------------------------------------------------------------
Sub ChainAnalysis(ByRef iRang As Integer, ByRef X As Double, ByRef Y As Double, ByRef Z As Double, ByRef iValid As Integer)
    Dim Chain As String
    Dim Chain2 As String
    Dim Chain3 As String
    
    Chain = GetCellA(iRang)
    
    Select Case Chain
        Case Cst_strSTARTCurve
            iValid = Cst_iSTARTCurve
        Case Cst_strENDCurve
            iValid = Cst_iENDCurve
        Case Cst_strSTARTLoft
            iValid = Cst_iSTARTLoft
        Case Cst_strENDLoft
            iValid = Cst_iENDLoft
        Case Cst_strSTARTCoord
            iValid = Cst_iSTARTCoord
        Case Cst_strENDCoord
            iValid = Cst_iENDCoord
        Case Cst_strEND
            iValid = Cst_iEND
        Case Else
            iValid = 0
    End Select
    If (iValid <> 0) Then
        Exit Sub
    End If
    
    
    
    'Conversion string -> double
    Chain2 = GetCellB(iRang)
    Chain3 = GetCellC(iRang)
    If ((Len(Chain) > 0) And (Len(Chain2) > 0) And (Len(Chain3) > 0)) Then
        X = CDbl(Chain)
        Y = CDbl(Chain2)
        Z = CDbl(Chain3)
    Else
        iValid = Cst_iERRORCool
        X = 0#
        Y = 0#
        Z = 0#
    End If
End Sub
'------------------------------------------------------------------------
' Get CATIA Application
'------------------------------------------------------------------------
'Remark:
'   When KO, update CATIA registers with:
'                       CNEXT /unregserver
'                       CNEXT /regserver
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Function GetCATIA() As Object
    Set CATIA = GetObject(, "CATIA.Application")
    If CATIA Is Nothing Then
       Set CATIA = CreateObject("CATIA.Application")
       CATIA.Visible = True
    End If
    
    Set GetCATIA = CATIA
End Function
'------------------------------------------------------------------------
' Get CATIADocument
'------------------------------------------------------------------------
Function GetCATIAPartDocument() As Object
    Set CATIA = GetCATIA
    
    Dim MyPartDocument As Object
    Set MyPartDocument = CATIA.ActiveDocument
    
    Set GetCATIAPartDocument = MyPartDocument
End Function
'------------------------------------------------------------------------
' Creates all usable points from the parameter file
'------------------------------------------------------------------------
Sub CreationPoint()

    'Get CATIA
    Dim PtDoc As Object
    Set PtDoc = GetCATIAPartDocument
    
    ' Get the HybridBody
    Dim myHBody As Object
    Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")
    
    Dim iLigne As Integer
    Dim iValid As Integer
    Dim X As Double
    Dim Y As Double
    Dim Z As Double
    Dim Point As Object
    
    iLigne = 1
    'Analyze file
    While iValid <> Cst_iEND
        'Read a line
        ChainAnalysis iLigne, X, Y, Z, iValid
        iLigne = iLigne + 1
        
        'Not on a startcurve or endcurve -> valid point
        If (iValid = 0) Then
            Set Point = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X, Y, Z)
            myHBody.AppendHybridShape Point
        End If
    Wend
    
    'Model update
    PtDoc.Part.Update
End Sub
'------------------------------------------------------------------------
' Creates all usable points and splines from the parameter file
'------------------------------------------------------------------------
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'Limitations:
'   ============================> NO MORE THAN 500 POINTS PER SPLINE
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub CreationSpline()
    'Limitation : points per spline
    Const NBMaxPtParSpline As Integer = 500
    
    'Get CATIA
    Dim PtDoc As Object
    Set PtDoc = GetCATIAPartDocument
    
    'Get HybridBody
    Dim myHBody As Object
    Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")
    
    
    
    Dim iRang As Integer
    Dim iValid As Integer
    Dim X1 As Double
    Dim Y1 As Double
    Dim Z1 As Double
    Dim index As Integer
    Dim PassingPtArray(1 To NBMaxPtParSpline) As Object
    Dim spline As Object
    Dim ReferenceOnPoint   As Object
    Dim SplineCtrPt As Object
    
    
    iValid = 0
    iRang = 1
    'Analyze file
    While iValid <> Cst_iEND
    
        'reinitialization of point array of the spline
        index = 0
        
        
        'Remove records before StartCurve
        While ((iValid <> Cst_iSTARTCurve) And (iValid <> Cst_iEND))
            ChainAnalysis iRang, X1, Y1, Z1, iValid
            iRang = iRang + 1
        Wend
        
        If (iValid <> Cst_iEND) Then
            'Read until endcurve -> Spline completed
            While ((iValid <> Cst_iENDCurve) And (iValid <> Cst_iEND))
                ChainAnalysis iRang, X1, Y1, Z1, iValid
                iRang = iRang + 1
        
        
                'valid point
                If (iValid = 0) Then
                    index = index + 1
                    If (index > NBMaxPtParSpline) Then
                        MsgBox "Too many points for a spline. Point deleted"
                    Else
                        Set PassingPtArray(index) = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X1, Y1, Z1)
                        myHBody.AppendHybridShape PassingPtArray(index)
                    End If
                End If
            Wend
    
        
        
        
            'Start building spline
            'Are there enough points ?
            If (index < 2) Then
                MsgBox "Not enough points for a spline. Spline deleted"
            Else
                Set spline = PtDoc.Part.HybridShapeFactory.AddNewSpline
                spline.SetSplineType 0
                spline.SetClosing 0
    
    
                'Creates and adds points to the spline
                For i = 1 To index
                    Set ReferenceOnPoint = PtDoc.Part.CreateReferenceFromObject(PassingPtArray(i))
                    '    ---- Version Before V5R12
                    ' Set SplineCtrPt = PtDoc.Part.HybridShapeFactory.AddNewControlPoint(ReferenceOnPoint)
                    ' spline.AddControlPoint SplineCtrPt
                                      
                    '    ---- Since V5R12
                     spline.AddPointWithConstraintExplicit ReferenceOnPoint, Nothing, -1, 1, Nothing, 0

                Next i
    
                myHBody.AppendHybridShape spline
            End If
        End If
    Wend
    
    PtDoc.Part.Update
End Sub
Sub LookForNextSpline(ByRef iRang As Integer, ByRef spline As Object, ByRef iValid As Integer, ByRef iOKSpline)
    'Limitation number off point per spline
    Const NBMaxPtParSpline As Integer = 500
    
    'Get CATIA
    Dim PtDoc As Object
    Set PtDoc = GetCATIAPartDocument
    
    'Get HybridBody
    Dim myHBody As Object
    Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")
    
    Dim X1 As Double
    Dim Y1 As Double
    Dim Z1 As Double
    Dim index As Integer
    Dim PassingPtArray(1 To NBMaxPtParSpline) As Object
    Dim ReferenceOnPoint   As Object
    Dim SplineCtrPt As Object
    
    
    iValid = 0
    iOKSpline = 0
    
    'reinitialization of point array of the spline
    index = 0
        
        
    'Remove records before StartCurve
    While ((iValid <> Cst_iSTARTCurve) And (iValid <> Cst_iEND))
        ChainAnalysis iRang, X1, Y1, Z1, iValid
        iRang = iRang + 1
    Wend
        
    If (iValid <> Cst_iEND) Then
        'Read until endcurve -> Spline completed
        While ((iValid <> Cst_iENDCurve) And (iValid <> Cst_iEND))
            ChainAnalysis iRang, X1, Y1, Z1, iValid
            iRang = iRang + 1
        
        
            'valid point
            If (iValid = 0) Then
                index = index + 1
                If (index > NBMaxPtParSpline) Then
                    MsgBox "Too many points for a spline. Point deleted"
                Else
                    Set PassingPtArray(index) = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X1, Y1, Z1)
                    myHBody.AppendHybridShape PassingPtArray(index)
                End If
            End If
        Wend
    
        
        
        
        'Start building spline
        'Are there enough points ?
        If (index < 2) Then
            MsgBox "Not enough points for a spline. Spline deleted"
        Else
            Set spline = PtDoc.Part.HybridShapeFactory.AddNewSpline
    
            'Creates and adds points to the spline
            For i = 1 To index
                Set ReferenceOnPoint = PtDoc.Part.CreateReferenceFromObject(PassingPtArray(i))
           '    ---- Version Before V5R12
           '    Set SplineCtrPt = PtDoc.Part.HybridShapeFactory.AddNewControlPoint(ReferenceOnPoint)
           '    spline.AddControlPoint SplineCtrPt
          
          
           '    ---- Since V5R12
                spline.AddPointWithConstraintExplicit ReferenceOnPoint, Nothing, -1, 1#, Nothing, 0#

            Next i
    
            myHBody.AppendHybridShape spline
            spline.SetSplineType 0
            spline.SetClosing 0
            iOKSpline = 1
        End If
    End If
End Sub
'------------------------------------------------------------------------
' Creates all usable points, splines and loft from the parameter file
'------------------------------------------------------------------------
'Limitations:
'   ============================> NO MORE THAN 500 POINTS PER SPLINE
'   ============================> NO MORE THAN 50 SPLINEs PER LOFT
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Sub CreationLoft()
    'Limitations
    Const NBMaxPtParSpline As Integer = 500
    Const NBMaxSplineParLoft As Integer = 50

    'Get CATIA
    Dim PtDoc As Object
    Set PtDoc = GetCATIAPartDocument
    
    'Get HybridBody
    Dim myHBody As Object
    Set myHBody = PtDoc.Part.HybridBodies.Item("GeometryFromExcel")
    
    
    
    Dim iRang As Integer
    Dim iValid As Integer
    Dim X1 As Double
    Dim Y1 As Double
    Dim Z1 As Double
    Dim index As Integer
    Dim indexSpline As Integer
    Dim SplineArray(1 To NBMaxSplineParLoft) As Object
    Dim Ref   As Object
    Dim CtrPt As Object
    
    
    indexSpline = 1
    iValid = 0
    iRang = 1
    
    'Analyze file
    While iValid <> Cst_iEND
    
        index = 0
        
        'Remove records before StartLoft
        While (iValid <> Cst_iSTARTLoft)
            ChainAnalysis iRang, X1, Y1, Z1, iValid
            iRang = iRang + 1
        Wend
        
        'Search curve defining the loft
        While (iValid <> Cst_iEND)
            If (indexSpline > NBMaxSplineParLoft) Then
                MsgBox "Too many splines for the loft"
                iValid = Cst_iEND
            Else
                LookForNextSpline iRang, SplineArray(indexSpline), iValid, iOKSpline
                If (iOKSpline = 1) Then
                    indexSpline = indexSpline + 1
                End If
                If (iValid = Cst_iEND) Then
                    indexSpline = indexSpline - 1
                End If
            End If
        Wend
    Wend
    
    
    '--------------------------------------------------------------------------------------------
    ' Create the loft
    '--------------------------------------------------------------------------------------------
    If (indexSpline > 1) Then
        Dim Loft As Object
        Set Loft = PtDoc.Part.HybridShapeFactory.AddNewLoft
        
        Dim LocalRefSpline As Object
        Dim SectionLoft As Object
        
        For i = 1 To indexSpline
            Set LocalRefSpline = PtDoc.Part.CreateReferenceFromGeometry(SplineArray(i))
            '    ---- Version Before V5R12
            ' Set SectionLoft = PtDoc.Part.HybridShapeFactory.AddNewLoftSection(LocalRefSpline, 1)
            ' Loft.AddSection SectionLoft
                      
            '    ---- Since V5R12
            Loft.AddSectionToLoft LocalRefSpline, 1, Nothing

            
        Next i
        
        myHBody.AppendHybridShape Loft
    End If
    ' Model update
    PtDoc.Part.Update
End Sub
'------------------------------------------------------------------------
'Main program
'------------------------------------------------------------------------
Sub Main()
        
    'Get the type of operations to do:
    '   Points                  --> 1
    '   Splines + Points        --> 2
    '   Loft + Splines + Points --> 3
    
    
    Dim TypeFile As Integer
    TypeFile = GetTypeFile
    
    ' V5R12 - Create dedicate opneBody for created geometry
    'Get CATIA
    Dim PtDoc As Object
    Set PtDoc = GetCATIAPartDocument
    
    ' Create Open body
    Set myHBody = PtDoc.Part.HybridBodies.Add()
    Set referencebody = PtDoc.Part.CreateReferenceFromObject(myHBody)
    PtDoc.Part.HybridShapeFactory.ChangeFeatureName referencebody, "GeometryFromExcel"
    
    
    If TypeFile = 1 Then
        CreationPoint
    ElseIf TypeFile = 2 Then
        CreationSpline
    ElseIf TypeFile = 3 Then
        CreationLoft
    End If
    
    
End Sub


Cordialement.

Mounssif

Bonjour,
J'ai testé la macro en R23, elle fonctionne sans problème.
Le problème doit plutôt venir des valeurs décimales dans votre tableau : il faut des virgules et pas des points.
J'ai essayé avec 100.0056 et obtenu la même erreur que vous.
Faites le test avec que des valeurs entières et ensuite avec des virgules comme séparateur de décimal.

Bonjour,
Vous aviez raison! J'ai remplacé le point par des virgules et ceci marcha sans problème. Merci beaucoup pour votre aide.
Cordialement.
Mounssif