 |
||
| ||
| |||||
| Dernière réponse | |
|---|---|
| Sujet : Points Excel -> splines | |
| happycode | Bonjour à tous, J'ai une petite question sur la connexion des points en utilisant des splines. Ce que je veux faire c’est importer des points à partir d'un fichier Excel, puis les connecter avec des lignes droites. J'ai utilisé la macro qui vient avec CATIA (GSD_PointSplineLoftFromExcel.xls) pour voir ce qu'elle fait et je me suis rendu compte qu’avec cette macro on peut relier les points, mais le résultat est une spline courbée (smooth) pas une connexion « linéaire » des points. Je souhaite modifier le code pour obtenir des lignes droites. J’imagine qu’il faudra juste changer quelques lignes de code, mais je ne sais pas comment faire (je suis nouveau dans les deux CATIA et Visual Basic ). [img]C:\jcamacho\Research SEP14-ON\Questiosn\SharpEdgeCatia\Resultat.bmp[/img] Pouvez-vous m’aider à modifier le code? Merci bcp ! PS : Désole pour les fautes d’orthographe, je ne suis pas francophone. '//============================================================================ '// 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 |
| Vue Rapide de la discussion |
|---|
