CATIADEV

Bonjour, je suis désolé de vous décevoir il n'existe pas et même pas dans la version R17. :P Bonne soirée. CATIADEV [Edité le 10/1/2007 par CATIADEV]

Bonjour à tous et meilleurs vœux pour cette nouvelle année ! Voilà, j'ai un souci à régler mais je n'arrive pas à m'en sortir. :casstet: Je réalise un outil qui fait automatiquement une pièce symétrique à partir d'un fichier CATPart existant. Soit toto200.CATPArt la pièce et toto201.CATPArt la symétrie de cette pièce. Pour vous donner une idée de l'outil, vous pouvez visiter ce lien : http:// http://patrick.dubernet.free.fr/Files/CATIA/ Des vidéos expliquent l'outil. Mon problème est que je n'arrive pas à obtenir l'outil Mirror Hole an CATVBA :mad: http://patrick.dubernet.free.fr/Files/CATIA/Toolbar.jpg Public Function fCPHoles(strOpenName As String, strFile201 As String) '------------------------------------- ' 'From 200 / copy / paste to 201 ' '------------------------------------- Dim srcDoc As PartDocument Set srcDoc = CATIA.Documents.Item(strOpenName) Dim srcPart As Part Set srcPart = srcDoc.Part '*************************************************************** Dim targetDoc As PartDocument Set targetDoc = CATIA.Documents.Item(strFile201 & ".CATPart") Dim targetPart As Part Set targetPart = targetDoc.Part '*************************************************************** Dim oSel As Selection Dim bodies1 As Bodies Dim body1 As Body Dim hybridBodies1 As HybridBodies Dim hybridBody1 As HybridBody 'Set ListeBody = srcDoc.Selection 'ListeBody.Clear 'ListeBody.Search "(Part Design.Body),all" 'ListeBody.Clear 'Dim BoxProduct 'BoxProduct = MsgBox("Quantity of the bodies found:" & srcDoc.Part.Bodies.Count & "", 64) Dim i As Integer For i = 1 To srcDoc.Part.Bodies.Count Set bodies1 = srcPart.Bodies 'Set body1 = srcPart.Bodies.Item(srcDoc.Part.InWorkObject.Name) Set body1 = srcPart.Bodies.Item(i) Dim strNameBody As String strNameBody = srcDoc.Part.InWorkObject.Name Dim partBody As Body Set partBody = srcDoc.Part.Bodies.Item(strNameBody) Dim intHoleType As Integer intHoleType = srcDoc.Part.Bodies.Item(strNameBody).HybridBodies.Count Dim j As Integer For j = 1 To intHoleType Set hybridBodies1 = srcDoc.Part.Bodies.Item(strNameBody).HybridBodies Set hybridBody1 = hybridBodies1.Item(j) Set oSel = srcDoc.Selection oSel.Add hybridBody1 oSel.Copy Set oSel = targetDoc.Selection oSel.Clear oSel.Add targetPart.Bodies.Item(strNameBody) oSel.Paste Dim strHoleType As String strHoleType = targetDoc.Part.Bodies.Item(strNameBody).HybridBodies.Item(j).Name targetDoc.Part.Bodies.Item(strNameBody).HybridBodies.Item(j).Name = Replace(strHoleType, strHoleType, srcDoc.Part.Bodies.Item(strNameBody).HybridBodies.Item(j).Name) Dim strBodyN As String strBodyN = targetDoc.Part.Bodies.Item(i).Name oSel.Clear Dim intElementHole As Integer intElementHole = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Count Dim e As Integer For e = 1 To intElementHole oSel.Add targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Item(e) Dim strHoleName As String strHoleName = oSel.Name 'Set body2 = targetPart.Bodies.Item(i) 'Set partBody = targetPart.Bodies.Item(i) 'Set oSel = targetPart.Bodies.Item(i) ' If frmSym201.ckbTexte = True Then 'ckbTexte = ResultOf ... ' ' Else ' body2.Name = Replace(body2.Name, "Result of ", "") ' End If ' A finaliser ne fonctionne pas !!!!!!!!!!!!!!! ------------- 'Dim shapeFactory1 As HybridShape 'ShapeFactory 'Set shapeFactory1 = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Item(e) 'HybridShapeFactory Dim hybridshape1 As HybridShape 'HybridShape 'ShapeFactory Set hybridshape1 = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j) '.HybridShapes.Item(e) Dim symAxisSystem1 As AxisSystems Set symAxisSystem1 = targetPart.AxisSystems Dim symRefAxisSystem1 As AxisSystem Set symRefAxisSystem1 = symAxisSystem1.Item("Absolute Axis System") Dim reference1 As Reference Set reference1 = targetPart.CreateReferenceFromBRepName _ ("RSur:(Face:(Brp:(AxisSystem.1;3);None:();Cf9:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", _ symRefAxisSystem1) 'Mise en place de l'objet pour la symétrie ------------------------ error ! Dim symmetry1 As HybridShapeFactory Set symmetry1 = hybridshape1 '.AddNewMirror(reference1) 'Dim hybridshape1 As HybridShape 'Set hybridshape1 = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Item(e) Set shapes1 = targetPart.Bodies.Item(j).HybridShapes 'HybridShapeFactory Dim strSymNbre As String strSymNbre = "Symmetry." & i + 100 Dim hybridShapeSymmetry1 As HybridShapeSymmetry Set hybridShapeSymmetry1 = shapes1 'hybridshape1 targetPart.InWorkObject = hybridShapeSymmetry1 targetPart.Update Set oSel = srcDoc.Selection oSel.Clear Next Next Next End Function Pouvez-vous m'aider à comprendre comment arriver à cet outil? Je n'arrive pas à l'atteindre ni depuis le partbody, ni depuis le geometricalset ni avec le ShapeFactory ... Bien à vous. Cordialement, Paloma [Edité le 10/1/2007 par CATIADEV]

Bonjour, Je développe aujourd'hui un outil qui permet de réaliser la pièce symétrique (toto_201.CATPart) d'une originale (tata_200.CATPart) Contenu de l'originale : 1 - Un à plusieurs Open body, 2 - un à plusieurs Holes, final Holes, etc. 3 - Un à plusieurs Geometrical set 4 - En plus du trièdre de la pièce, il y a un trièdre qui sert de plan de symétrie (x,z) ce trièdre doit être détruis à la fin du processus dans la pièce original L'outil fait : 1 - ouvre la pièce sélectionnée, 2 - créer un nouveau part et génère son nom en fonction de la pièce originale. (ici je n'arrive pas à faire des copier coller depuis la pièce originale vers la nouvelle pièce) PasteSpecial As result Donc pour le moment je suis obligé de fermer ma pièce 201. 3 - je sélectionne le premier open body et je le copie. 4 - j'essaye de le coller et CATIA plante. "Command Interruped" Si quelqu'un peu m'aider à comprendre? Voici mon code actuel : Function fPart(PartFile As String) 'Dim intCountItem As Integer 'Dim CourantObject As String CATIA.RefreshDisplay = False CATIA.DisplayFileAlerts = False 'Renomme les fichiers PRODUCT, replace les PART et sauvegarde ceux-ci dans le répertoire temporaire OUT '------------------------------------- ' ' Open a part 200 ' '------------------------------------- Language = "VBSCRIPT" Set Documents1 = CATIA.Documents Dim partDocument1 As Document Set partDocument1 = Documents1.Open(PartFile) ' Retrieving a Part HybridBodies collection to attaching OpenBodies (Geometrical set) Dim hybridBodies1 As HybridBodies Set hybridBodies1 = partDocument1.Part.HybridBodies Dim partBodies1 As Bodies Set partBodies1 = partDocument1.Part.Bodies Dim partBody As Body Dim strNameBody As String strNameBody = partDocument1.Part.InWorkObject.Name Set partBody = partDocument1.Part.Bodies.Item(strNameBody) Dim str201PartName As String str201PartName = Replace(PartFile, "200", "201") '------------------------------------- ' ' Create a new part for 201 ' '------------------------------------- Dim intPosition As Integer intPosition = InStrRev(PartFile, "\") Dim strShortFileOpenName As String strShortFileOpenName = Mid(PartFile, intPosition + 1) Dim str201Name As String str201Name = Replace(strShortFileOpenName, "20000", "20100", 1, vbTextCompare) 'MsgBox str201Name, vbCritical, "New Part Name" Dim intDotPosition As Integer intDotPosition = InStrRev(str201Name, ".") Dim strNewFile201 As String strNewFile201 = Left(str201Name, intDotPosition - 1) Set documents2 = CATIA.Documents Set partDocument2 = documents2.Add("Part") ' renomme le fichier standard part en part 201 ------------------------------------- Set product2 = partDocument2.Product product2.PartNumber = Replace(partDocument2.Name, partDocument2.Name, strNewFile201) partDocument2.Close '------------------------------------- ' 'From 200 / copy / paste to 201 ' '------------------------------------- Set specsAndGeomWindow2 = CATIA.ActiveWindow Set partDocument1 = CATIA.ActiveDocument Dim selection1 As Selection Set selection1 = partDocument1.Selection If Selection = True Then selection1.Clear Else End If Dim part1 As Part Set part1 = partDocument1.Part Dim bodies1 As Bodies Dim body1 As Body Set bodies1 = part1.Bodies Set body1 = bodies1.Item(strNameBody) selection1.Add body1 selection1.Copy ' Fait planter CATIA !!!!!!! 'CATIA.ActiveDocument.Selection.PasteSpecial "CATIA_RESULT" 'Set specsAndGeomWindow2 = CATIA.ActiveWindow 'Set viewerpoint3D2 = specsAndGeomWindow2.ActiveViewer 'Set viewpoint3D2 = viewerpoint3D2.Viewpoint3D ' ''Dim partDocument2 As Document 'Set partDocument2 = CATIA.ActiveDocument ' 'Dim part2 As PartDocument 'Set part2 = partDocument2 ' 'part2.Activate ' 'Set bodies2 = part2.Selection 'Set body2 = bodies1.Item("Res") 'partBodies1.Add 'selection1.PasteSpecial (fgfd) 'CATIA.ActiveDocument.Selection.PasteSpecial "CATIA_RESULT" '****************************** ' Updating CATIA PArt 'partDocument1.Part.Update partDocument2.SaveAs str201PartName partDocument2.Close End Function Cordialement, CATIADEV

Bonjour, Voilà un truc qui peu t'intérésser : :D Private Sub CmdBrowseXLSFile_Click() ' Pacourir les répertoires pour accéder au fichier .XLS On Error GoTo ErrorFile winCmd.CancelError = True winCmd.InitDir = "c:\" winCmd.Filter = "Csv File (.XLS)|*.XLS" winCmd.FilterIndex = 1 winCmd.Action = 1 winCmd.ShowOpen strPathCsv = winCmd.FileName If winCmd.FileName <> "Null" Then ' Permet de modifier la valeur Text du champ de texte. txtPathExcelFile.Text = strPathCsv 'indique le chemin complet txtPathExcelFile.BackColor = &H80000005 'change la couleur du label 'affichage du bouton Start cmdStart.Visible = True Else 'txtPathExcelFile.Text = "Please select an .XLS reference file" End If Exit Sub ErrorFile: MsgBox "Please select an .XLS reference file", vbCritical, "!STOP!" End Sub Ya des trucs en plus mais tu fait un peu de trie et c'est ok :P @ plus CATIADEV

Bonjour, Il n'est pas possible de manipuler des fichiers qui ne sont pas "ouvert" dans CATIA. :casstet: Donc, tu récupère dans ton draw le fichier qui a servi à faire ta/tes vue(s) puis tu l'ouvres et tu récupère la masse que tu passe dans une variable de type Integer. Ensuite tu convertis le type int en string. :exclam: puis tu fermes ton Part ou product, là le draw est actif dans l'état ou tu l'avais laissé puis tu utilises le contenu de ta variable string pour mettre à jour ton cartouche. Have fun ! :D CATIADEV

Salut, tu peux faire un : For Each myProduct In products1 ' ---- là, tu passes tous les part un par un ---- On Error Resume Next tu fait tt ce que tu veux Next ..... :D voili voilou CATIADEV [Edité le 22/11/2006 par CATIADEV]

Bonjour, par exemple : CurView.GenerativeBehavior.Document.Name pour le nom et TypeName(CurView.GenerativeLinks.FirstLink()) pour le type (Part/Product) ... @ plus CATIADEV

Bonjour à tous, ça fait longtemps que je ne suis pas venu ici pour poser une question. Entre temps j'ai perdu mon login, puis je n'arrivais plus à me connecté ... enfin bref me revoilou avec une question :casstet: Voià, je développe depuis un mois environ un outil en visual basic (VBA) qui me permet de passer une liste complète d'assemblage, piéces et plan vers un nouveau nom. exemple : TOTO.CAT* vers TITO.CAT* mais chaque type est traité indivuiduallement. Pour les Part et les Product tout fonctionne :D Alors venons en au faits. Voici le code de ma fonction fDraw qui traite mes CATDrawing. ************************************************************ ' Fonction qui traite les fichiers CATDrawing. ' Toutes types de mofifications peuvent être apportés à cette fonction. (voir V5Automation.chm) Function fDraw(PathInterTemp As String, DrawFile As String, DrawPathOut As String, ParentDirectoryOldFile As String, myDictionaryFile As Collection) ' Set the CATIA popup file alerts to False ' It prevents to stop the macro at each alert during its execution CATIA.DisplayFileAlerts = False 'renomme les fichiers Drawing et les sauvegardes dans le répertoire temporaire OUT Language = "VBSCRIPT" Dim drawingDocuments1 As DrawingDocument Dim drawingSheets As drawingSheet Dim drawingSheet As drawingSheet Dim MyView As DrawingView Dim partDocuments2 As PartDocument Dim productdocuments4 As ProductDocument Dim strActiveDoc As String Set documents1 = CATIA.documents Dim strExtFile As String ' open the drawing file one by one ------------------------------------------------------------ Set drawingDocument1 = documents1.Open(ParentDirectoryOldFile + DrawFile) 'strActiveDoc = drawingDocuments1.FullName 'Call ListParentDraw(drawingDocuments1) Dim DrwDoc As Document Set DrwDoc = CATIA.ActiveDocument If InStr(DrwDoc.Name, ".CATDrawing") = 0 Then MsgBox "The Active Document must be a CATDrawing." 'Exit Sub End If Dim DrwSheets As drawingSheets Set DrwSheets = DrwDoc.Sheets Dim DrwSheet As drawingSheet Set DrwSheet = DrwSheets.Item(1) Dim DrwViews As DrawingViews Set DrwViews = DrwSheet.Views Dim CurView As DrawingView Dim ViewLinks As DrawingViewGenerativeLinks Dim fLink As AnyObject Dim dictFile As New FileDictionary Dim i As Integer For i = 3 To DrwViews.count Set CurView = DrwViews.Item(i) Set ViewLinks = CurView.GenerativeLinks Set fLink = ViewLinks.FirstLink() CurView.LockStatus = False 'affiche si c'est un part ou un product ----------------------------------------------------------- 'MsgBox TypeName(fLink) Dim strType As String 'recupération du type de fichier Part ou Product *********** strType = TypeName(fLink) 'retourne the short name of the document to serve to generate this active view. ----- 'MsgBox "The active view was generated from " + CurView.GenerativeBehavior.Document.Name + ".CAT" + strType, vbInformation ' definition de l'extension de fichier à trouver dans le dictionnaire et à ouvrir ----------------------- If CStr(TypeName(CurView.GenerativeLinks.FirstLink())) = "Product" Then strType = ".CATProduct" Else strType = ".CATPart" End If ' search in dictionnary class the file corresponding ------------------------------------------------------------- Dim strNewName As String strNewName = dictFile.FindNewFileName(myDictionaryFile, CurView.GenerativeBehavior.Document.Name & strType) Debug.Print (CurView.GenerativeBehavior.Document.Name & strType + " ----> " + strNewName) 'ouverture du fichier 3D correspondnat -------------------------------------------------------------------------- Dim str3DOpenDocument As String If strType = ".CATProduct" Then Set productdocuments4 = documents1.Open(PathInterTemp + strNewName) Else Set partDocuments2 = documents1.Open(PathInterTemp + strNewName) End If str3DOpenDocument = PathInterTemp + strNewName Dim iLink As String iLink = PathInterTemp + strNewName 'Debug.Print (iLink) Set drawingDocument1 = CATIA.ActiveDocument 'Set CurView = drawingDocuments1.Sheets.ActiveSheet.Views.ActiveView 'suppression des mauvais liens ------------------------------- 'ViewLinks.RemoveAllLinks ' replace part or product new link --------------------------- ' Dim ViweLinks As DrawingViewGenerativeLinks ' Set ViewLinks = CurView.GenerativeLinks CurView.GenerativeLinks.AddLink (strNewName) CurView.LockStatus = True Next drawingDocument1.SaveAs DrawPathOut & strNewName drawingDocument1.Close CATIA.DisplayFileAlerts = True End Function ************************************************************ Le problème est que je n'arrive pas après avoir ouvers le bon fichier 3D, récupérer l'info que je dois passer au draw. Je n'arrive pas non plus à afficher en avant plant le draw (rappel, la fonction ouvre un draw puis cherche le doc. 3d qui a servi à faire ce draw puis l'ouvre puis revien sur le draw et met à jour les liens) Enfin, je n'arrive pas à faire un addView, faut-il faire impérativement un RemoveAllLinks avant? Quelqu'un peut-il m'aider? Merci à vous. Cordialement, CATIADEV (ex. CATDEV)[Edité le 22/11/2006 par CATIADEV][Edité le 22/11/2006 par CATIADEV] [Edité le 22/11/2006 par CATIADEV]