Extraction de points d'esquisse
2 participants
Page 1 sur 1
Extraction de points d'esquisse
Salut tout le monde,
Je voudrais savoir s'il y avait un moyen d'extraire des points qui sont sur les esquisses.
Je m'explique: j'ai des tuyaux et je voudrais extraire les points de départ et de fin de ces tuyaux qui sont variables.
Je voulais savoir comment extraire ces points via une macro.
Je me doute qu'il va y avoir ce genre de lignes de commande:
Dim oPoint As GeometricElement
Sub GetCoordinates( CATSafeArrayVariant oPoint)
ou
objProduct.GetPointsOnCurve Coordinates
Une idée?
Je voudrais savoir s'il y avait un moyen d'extraire des points qui sont sur les esquisses.
Je m'explique: j'ai des tuyaux et je voudrais extraire les points de départ et de fin de ces tuyaux qui sont variables.
Je voulais savoir comment extraire ces points via une macro.
Je me doute qu'il va y avoir ce genre de lignes de commande:
Dim oPoint As GeometricElement
Sub GetCoordinates( CATSafeArrayVariant oPoint)
ou
objProduct.GetPointsOnCurve Coordinates
Une idée?
Dernière édition par Nico_atomique le Mer 29 Juin 2016 - 8:32, édité 3 fois
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
As tu essayé :
Pour la suite ça dépend ce que tu veux exporter et vers où.
As tu essayé :
- Code:
Language="VBSCRIPT"
Sub CATMain()
Set partDocument1 = CATIA.ActiveDocument
Set selection1 = partDocument1.Selection
selection1.Search " CATSketchSearch.2DPoint,all"
msgbox "Nombre de point dans les esquisses : " & selection1.count
'selection1.Clear
End Sub
Pour la suite ça dépend ce que tu veux exporter et vers où.
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Salut Marc,
Non je n'ai pas essayé, le problème est que je souhaite extraire uniquement certains points de mon esquisse, pas tous, et malheureusement je n'ai aucune idée de comment automatiser la sélection de ces points précis (ces points précis étant les fins de tuyauteries, coudes et tés), pas seulement parce que je ne sais pas trop comment faire, mais également parce que je ne suis pas sûr que ces points seront toujours les points voulus.
De plus, les assemblages sur lesquels je bosse, sont des assemblages de 250+ pièces, je dois pouvoir extraire les infos nécessaires, rien de plus.
Je me demande si ce n'est pas possible de trouver ces points via les surface en fait, du genre coordonnées du centre de la surface que l'on va noter origine puis coordonnées de la 2e surface...
Non je n'ai pas essayé, le problème est que je souhaite extraire uniquement certains points de mon esquisse, pas tous, et malheureusement je n'ai aucune idée de comment automatiser la sélection de ces points précis (ces points précis étant les fins de tuyauteries, coudes et tés), pas seulement parce que je ne sais pas trop comment faire, mais également parce que je ne suis pas sûr que ces points seront toujours les points voulus.
De plus, les assemblages sur lesquels je bosse, sont des assemblages de 250+ pièces, je dois pouvoir extraire les infos nécessaires, rien de plus.
Je me demande si ce n'est pas possible de trouver ces points via les surface en fait, du genre coordonnées du centre de la surface que l'on va noter origine puis coordonnées de la 2e surface...
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Il faut effectivement trouver un moyen de filtrer la sélection.
Il est possible de rechercher les cercles dans les esquisses et de récupérer les points des extrémités (comme sur ton image) : le problème est que l'on récupère des point 2D (uniquement coordonnées X,Y dans le plan de l'esquisse).
Est ce qu'il te faut des points 3D?
Les cercles à l'extrémité de tes raccords ont ils un nom particulier?
Tu programmes en VBA ou en VBScript?
Il faut effectivement trouver un moyen de filtrer la sélection.
Il est possible de rechercher les cercles dans les esquisses et de récupérer les points des extrémités (comme sur ton image) : le problème est que l'on récupère des point 2D (uniquement coordonnées X,Y dans le plan de l'esquisse).
Est ce qu'il te faut des points 3D?
Les cercles à l'extrémité de tes raccords ont ils un nom particulier?
Tu programmes en VBA ou en VBScript?
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Salut Marc,
J'ai eu de l'aide sur eng-tips.com et en fait j'ai changé la façon de faire: si je passe par les surface, je peux extraire les coordonnées du système général (dans ma 1ere idée, si j'extrayais les points d'esquisse, j'aurais récupéré uniquement en 2D et dans le référentiel esquisse, ce qui n'était pas mon objectif)
Voici le code utilisé
De cette façon, je peux récupérer les "edges" des cylindres et trouver le centre dans le référentiel de l'assemblage.
Par contre j'ai essayé de rajouter la commande "measurable.GetRadius" mais ça me dit que ça ne gère pas cette méthode, une idée?
J'ai eu de l'aide sur eng-tips.com et en fait j'ai changé la façon de faire: si je passe par les surface, je peux extraire les coordonnées du système général (dans ma 1ere idée, si j'extrayais les points d'esquisse, j'aurais récupéré uniquement en 2D et dans le référentiel esquisse, ce qui n'était pas mon objectif)
Voici le code utilisé
- Code:
Sub CATMain()
Dim doc, sel, spa, ref, measurable
Dim inputObjectType(0)
Set doc = CATIA.ActiveDocument
Set sel = doc.selection
Set spa = doc.GetWorkbench("SPAWorkbench")
'Selection of circular edge
inputObjectType(0) = "TriDimFeatEdge"
Status = sel.SelectElement2(inputObjectType, "Select the edge", True)
If (Status = "cancel") Then Exit Sub
Set ref = sel.Item(1).Reference
Set measurable = spa.GetMeasurable(ref)
sel.Clear
Dim Coordinates(2)
measurable.GetCenter Coordinates
MsgBox "x = " & Coordinates(0) & " ; y = " & Coordinates(1) & " ; z = " & Coordinates(2)
End Sub
De cette façon, je peux récupérer les "edges" des cylindres et trouver le centre dans le référentiel de l'assemblage.
Par contre j'ai essayé de rajouter la commande "measurable.GetRadius" mais ça me dit que ça ne gère pas cette méthode, une idée?
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Pour le rayon : measurable.Radius
Si tu programmes en VBA tu peux voir la valeur des variables et leur différente méthode (voir image si dessous)
C'est très pratique pour la programmation, tu peux ensuite repasser en VBscript avec quelques restriction.
Pour le rayon : measurable.Radius
Si tu programmes en VBA tu peux voir la valeur des variables et leur différente méthode (voir image si dessous)
C'est très pratique pour la programmation, tu peux ensuite repasser en VBscript avec quelques restriction.
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
En fait je partais sur une mauvaise commande: Set Radius = measurable.GetRadius.
Dans ce cas là, Radius est un Long donc il fallait enlever le Set et puis c'est pas GetRadius mais .Radius.
La bonne écriture est donc measurable.Radius comme tu l'as écrit
Merci
Dans ce cas là, Radius est un Long donc il fallait enlever le Set et puis c'est pas GetRadius mais .Radius.
La bonne écriture est donc measurable.Radius comme tu l'as écrit
Merci
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Me revoila sur un petit problème: j'ai fait une boucle pour pouvoir faire une sélection multiple de mes bordures circulaires, cependant, lors du premier passage, j'ai toutes mes infos extraites mais après ça me dit que le type Coordinates est non compatible, ce qui est bizarre car il l'est durant le 1er passage.
Je mets mon code au cas où quelqu'un voudrait le tester
Je mets mon code au cas où quelqu'un voudrait le tester
- Code:
Sub CATMain()
Dim intNbEdges As Integer
Dim doc, sel, spa, ref, measurable
Dim inputObjectType(0)
Dim i As Integer
Set doc = CATIA.ActiveDocument
Set sel = doc.selection
Set spa = doc.GetWorkbench("SPAWorkbench")
'Selection of circular edge
inputObjectType(0) = "TriDimFeatEdge"
Status = sel.SelectElement3(inputObjectType, "Select the edge", False, CATMultiSelTriggWhenUserValidatesSelection, False)
If (Status = "cancel") Then Exit Sub
intNbEdges = sel.Count
For i = 1 To intNbEdges
Set ref = sel.Item(i).Reference
Set measurable = spa.GetMeasurable(ref)
Dim Coordinates(2)
measurable.GetCenter Coordinates
Dim Radius As Long
Radius = measurable.Radius
MsgBox "x = " & Coordinates(0) & Chr(10) & "y = " & Coordinates(1) & Chr(10) & "z = " & Coordinates(2) & Chr(10) & "Diametre = " & 2*Radius
Err.Clear
Next
End Sub
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Même erreur que toi en VBscript mais ça fonctionne en VBA
Même erreur que toi en VBscript mais ça fonctionne en VBA
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Salut Marc
En fait il faut rajouter un "On Error Resume Next" directement en début de boucle, juste après le "For i = 1 To intNbEdges" ainsi qu'un "On Error Goto 0" juste avant la MsgBox, et ça va marcher.
Par contre, aurais-tu une idée quant à la sélection: je voudrais sélectionner automatiquement les bordures circulaires de mon part via une boucle mais je n'arrive pas.
J'ai essayé plusieurs façons de faire, mais vu que j'ai des assemblages de 250+ pièces, il faudrait que ça se sélectionne tout seul.
J'ai essayé une palette de sélection par trappe, mais la trappe ne marche pas, juste la sélection par click, et comme j'ai dit plus haut, sur un assemblage de 250+ pièces, avec au moins 2 bordures par pièces, je peux pas faire ça à l'utilisateur
Mais ça ne marche pas.
En fait il faut rajouter un "On Error Resume Next" directement en début de boucle, juste après le "For i = 1 To intNbEdges" ainsi qu'un "On Error Goto 0" juste avant la MsgBox, et ça va marcher.
Par contre, aurais-tu une idée quant à la sélection: je voudrais sélectionner automatiquement les bordures circulaires de mon part via une boucle mais je n'arrive pas.
J'ai essayé plusieurs façons de faire, mais vu que j'ai des assemblages de 250+ pièces, il faudrait que ça se sélectionne tout seul.
J'ai essayé une palette de sélection par trappe, mais la trappe ne marche pas, juste la sélection par click, et comme j'ai dit plus haut, sur un assemblage de 250+ pièces, avec au moins 2 bordures par pièces, je peux pas faire ça à l'utilisateur
- Code:
Status = sel.SelectElement3(inputObjectType, "Select the edge", False, CATMultiSelTriggWhenUserValidatesSelection, True)
- Code:
selection.Search "(CATLndSearch.TriDimFeatEdge),all"
Mais ça ne marche pas.
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Je n'ai rien trouvé pour sélectionner directement les courbes, alors voici une nouvelle piste :
-sélectionner toutes les arrêtes avec sel.Search "Topology.CGMEdge,all"
-traiter celles iui sont du type "TriDimFeatEdge".
Ça donne :
Je n'ai rien trouvé pour sélectionner directement les courbes, alors voici une nouvelle piste :
-sélectionner toutes les arrêtes avec sel.Search "Topology.CGMEdge,all"
-traiter celles iui sont du type "TriDimFeatEdge".
Ça donne :
- Code:
Sub CATMain()
'*** http://catiav5.forumactif.org/t1456-extraction-de-points-d-esquisse#6498 ***
Dim intNbEdges As Integer
Dim doc, sel, spa, ref, measurable
Dim inputObjectType(0)
Dim i As Integer
Set doc = CATIA.ActiveDocument
Set sel = doc.Selection
Set spa = doc.GetWorkbench("SPAWorkbench")
sel.Search "Topology.CGMEdge,all"
intNbEdges = sel.Count
For i = 1 To intNbEdges
Set myCircle = sel.Item(i)
If myCircle.Type = "TriDimFeatEdge" Then
Set ref = sel.Item(i).Reference
Set measurable = spa.GetMeasurable(ref)
Dim Coordinates(2)
measurable.GetCenter Coordinates
Dim Radius As Long
Radius = measurable.Radius
MsgBox "x = " & Coordinates(0) & Chr(10) & "y = " & Coordinates(1) & Chr(10) & "z = " & Coordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
Err.Clear
End If
Next
End Sub
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Salut Marc,
C'est génial, merci!
J'avais essayé sel.Search("Type=TriDimFeatEdge, all") mais ça ne marchait pas, et je n'arrivais pas à trouver la bonne façon de l'écrire.
L'ennui avec la doc Catia c'est que des commandes et méthodes telles que Topology.CGMEdge ne sont pas renseignées, ce qui n'aide pas si on ne les connait pas...
En tout cas merci, je pense que je vais pouvoir finir tout seul
C'est génial, merci!
J'avais essayé sel.Search("Type=TriDimFeatEdge, all") mais ça ne marchait pas, et je n'arrivais pas à trouver la bonne façon de l'écrire.
L'ennui avec la doc Catia c'est que des commandes et méthodes telles que Topology.CGMEdge ne sont pas renseignées, ce qui n'aide pas si on ne les connait pas...
En tout cas merci, je pense que je vais pouvoir finir tout seul
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Je reviens sur ce que j'ai dit, j'ai un petit problème pour intégrer cette boucle dans ma plus grande boucle
L'ennui c'est que j'ai l'impression que j'ai aucune sélection de mes edges qui se fait dans la boucle, ça doit être en rapport avec le sel, mais j'ai beau faire un Set sel= Nothing, ou un sel.Clear, ça me fait pas une sélection après...
J'ai également essayé un Sel sel = objGCATIASelection0.Item(i) pour un sel.Search "Topology.CGMEdge,all" après. Mais échec également
Aurais-tu également une écriture pour excel, à supposer que je garde 2 ou 3 jeux de coordonnées à chaque fois?
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm" pourrait marcher mais ça va uniquement prendre la dernière valeur
Dois-je rajouter un .Item(0) quelque part avant ou après le oCoordinates(0)?
- Code:
Sub CATMain()
Dim objProduct As Part
Dim objProductMat As Part
Dim intNbParts As Integer
Dim i As Integer
Dim intNbEdges As Integer
Dim doc, sel, spa, ref, measurable
Dim inputObjectType(0)
Dim j As Integer
StartCATIA
If Err.Number <> 0 Then
Exit Sub
End If
StartEXCEL
If Err.Number <> 0 Then
Exit Sub
End If
Set objGCATIASelection0 = objGCATIADocument0.Selection
Set objGCATIAProduct0 = objGCATIADocument0.Product
If objGCATIASelection0.Count = 0 Then
objGCATIASelection0.Search "(CATLndSearch.Part),all"
End If
intNbParts = objGCATIASelection0.Count
For i = 1 To intNbParts
Set objProduct = Nothing
Set objProductMat = Nothing
Set objProduct = objGCATIASelection0.Item(i).Value
Set objProductMat = objGCATIASelection0.Item(i)
Err.Clear
Dim objInertia As Inertia
On Error Resume Next
Set objInertia = objProduct.GetTechnologicalObject("Inertia")
Dim getMass As String
getMass = objInertia.Mass
Dim partName As String
partName = objProduct.Name
Dim Mat As Material
Dim oManager As MaterialManager
Set oManager = objProductMat.GetItem("CATMatManagerVBExt")
oManager.GetMaterialOnPart objProductMat.ReferenceProduct.Parent.Part,Mat
matName = Mat.Name
Dim Coordinates(2)
objInertia.GetCOGPosition Coordinates
Sel sel = Nothing
Set spa = doc.GetWorkbench("SPAWorkbench")
If sel.Count = 0 Then
sel.Search "Topology.CGMEdge,all"
End If
intNbEdges = sel.Count
MsgBox intNbEdges
For j = 1 To intNbEdges
Set myCircle = sel.Item(j)
If myCircle.Type = "TriDimFeatEdge" Then
Set ref = sel.Item(j).Reference
Set measurable = spa.GetMeasurable(ref)
Dim oCoordinates(2)
measurable.GetCenter oCoordinates
Dim Radius As Long
Radius = measurable.Radius
MsgBox "x = " & oCoordinates(0) & Chr(10) & "y = " & oCoordinates(1) & Chr(10) & "z = " & oCoordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
Err.Clear
End If
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, oCoordinates(1) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, oCoordinates(2) & "mm"
Next
intGReportCurrentRow = intGReportCurrentRow + 1
InsertAnEXCELRowAt (intGReportCurrentRow)
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Coordinates(0) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Coordinates(1) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Coordinates(2) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName
Next
intGReportCurrentRow = intGReportCurrentRow + 1
InsertAnEXCELRowAt (intGReportCurrentRow)
End Sub '/////////////////////////////////////////////////////////// CATMain
L'ennui c'est que j'ai l'impression que j'ai aucune sélection de mes edges qui se fait dans la boucle, ça doit être en rapport avec le sel, mais j'ai beau faire un Set sel= Nothing, ou un sel.Clear, ça me fait pas une sélection après...
J'ai également essayé un Sel sel = objGCATIASelection0.Item(i) pour un sel.Search "Topology.CGMEdge,all" après. Mais échec également
Aurais-tu également une écriture pour excel, à supposer que je garde 2 ou 3 jeux de coordonnées à chaque fois?
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm" pourrait marcher mais ça va uniquement prendre la dernière valeur
Dois-je rajouter un .Item(0) quelque part avant ou après le oCoordinates(0)?
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Pour excel, je ne connais pas la syntaxe que tu utilise, pour remplir les tableaux j'utilise:
Voir un exemple ici:
https://catiav5.forumactif.org/t1452-catdrawing-vers-excel
Pour le problème de boucle je regarderai plus tard.
Pour excel, je ne connais pas la syntaxe que tu utilise, pour remplir les tableaux j'utilise:
- Code:
myworksheet.cells(i + 1, 3).Value = oCoorddinates(0)
Voir un exemple ici:
https://catiav5.forumactif.org/t1452-catdrawing-vers-excel
Pour le problème de boucle je regarderai plus tard.
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Pour mon fichier excel, j'ai un fichier de base référenct et le code va se baser dessus.
L'écriture se passe comme ceci (en gros) pour l'écriture excel:
Voila comment est organisé mon code, mais dans ce cas là, comment je peux faire pour prendre les coordonnées du premier item (edge circulaire) et les nommer en "coordonnées départ" puis prendre les coordonnées du 2e item pour "coordonnées fin" ...?
L'écriture se passe comme ceci (en gros) pour l'écriture excel:
- Code:
Const strGReportTitleDepX = "Départ X-Coord"
Dim intWhichColumn As Integer
intWhichColumn = 0
If (Len(istrValue) > 0) Then
Select Case iStrColumn
Case strGReportTitleDepX
intWhichColumn = intGReportStartAfterColumn + 14
End Select
End If
'// execution code
'//
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX oCoordinates(0) & "mm"
intGReportCurrentRow = intGReportCurrentRow +1
Voila comment est organisé mon code, mais dans ce cas là, comment je peux faire pour prendre les coordonnées du premier item (edge circulaire) et les nommer en "coordonnées départ" puis prendre les coordonnées du 2e item pour "coordonnées fin" ...?
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Je crois avoir compris d'où vient mon problème dans la boucle: je fais une première sélection avec objGCATIASelection0.Search "(CATLndSearch.Part),all".
Et après j'ai à faire une sélection, donc soit je fais un set sel = catia.Activedocument.selection, et dans ce cas, ça va me prendre les bordures de la sélection totale, soit j'ai fait un catia.activedocument.selection.item(i), ce qui ne marche pas avec sel.Search "topology.CGMEdge, all" vu que je suis sur un item et non pas une sélection.
Donc en fait il faut que je fasse une sélection de l'ensemble des Part, que je prenne l'item i, et dans cet item que je fasse une sélection de l'ensemble des bordures...
Et après j'ai à faire une sélection, donc soit je fais un set sel = catia.Activedocument.selection, et dans ce cas, ça va me prendre les bordures de la sélection totale, soit j'ai fait un catia.activedocument.selection.item(i), ce qui ne marche pas avec sel.Search "topology.CGMEdge, all" vu que je suis sur un item et non pas une sélection.
Donc en fait il faut que je fasse une sélection de l'ensemble des Part, que je prenne l'item i, et dans cet item que je fasse une sélection de l'ensemble des bordures...
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Bon ben malgré toutes mes tentatives, cela n'a rien donné.
Donc si quelqu'un a une idée sur comment corriger mon script pour que je puisse faire une sélection générale des parts, puis après, dans chaque item, faire une sélection des edges, ce serait très sympa qu'il m'aide
Merci
Donc si quelqu'un a une idée sur comment corriger mon script pour que je puisse faire une sélection générale des parts, puis après, dans chaque item, faire une sélection des edges, ce serait très sympa qu'il m'aide
Merci
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Peux tu poster le code complet, je pourrai le tester.
Tu lance bien ta macro avec un Catproduct (contenant tes CATpart tubes, coudes...) actif?
Peux tu poster le code complet, je pourrai le tester.
Tu lance bien ta macro avec un Catproduct (contenant tes CATpart tubes, coudes...) actif?
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Re..
Cette macro qui déroule le contenu d'un Product peut éventuellement t'aider:
Cette macro qui déroule le contenu d'un Product peut éventuellement t'aider:
- Code:
'---Script by Emmett Ross
'---www.scripting4v5.com
'---Revised July 21, 2012
'---This macro will walk down the tree and display the part number for every component and if it is a part or product
'--------------------------------------------------------------------------
Sub CATMain()
'Get the current CATIA assembly
Dim oProdDoc As ProductDocument
Set oProdDoc = CATIA.ActiveDocument
Dim oRootProd As Product
Set oRootProd = oProdDoc.Product
'Begin scroll down the specification tree
Call WalkDownTree(oRootProd)
End Sub
'---------------------------------------------------------------------
' WalkDownTree is a recursive function to scroll down the spec tree and output names of each item
Sub WalkDownTree(oInProduct As Product)
Dim oInstances As Products
Set oInstances = oInProduct.Products
'-----No instances found then this is CATPart
If oInstances.Count = 0 Then
MsgBox "This is a CATPart with part number " & oInProduct.PartNumber
Exit Sub
End If
'-----Found an instance therefore it is a CATProduct
MsgBox "This is a CATProduct with part number " & oInProduct.ReferenceProduct.PartNumber
Dim k As Integer
For k = 1 To oInstances.Count
Dim oInst As Product
Set oInst = oInstances.Item(k)
'apply design mode
oInstances.Item(k).ApplyWorkMode DESIGN_MODE
Call WalkDownTree(oInst)
Next
End Sub
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Salut Marc,
Je te poste ça et je vais voir la macro que tu as posté!
Merci
Code:
Là dans ce cas là, il me donne pas les extrémités, mais il me donne les infos sur les pièces.
Mais quand je modifie la 2ème sélection pour faire une sélection globale, dans ce cas là, ça me sort les extrémités globales et ça me change les noms de la pièce dans le fichier excel
Je te poste ça et je vais voir la macro que tu as posté!
Merci
Code:
- Code:
Const intGTraceLevel = 1
'// ---------- EXCEL Run Report Format
Const strGReportTitleInstanceName = "Run name"
Const strGReportTitleNodeNumber = "Node name"
Const strGReportTitleNodeX = "X-coord"
Const strGReportTitleNodeY = "Y-coord"
Const strGReportTitleNodeZ = "Z-coord"
Const strGReportTitleBlendRadius = "Bend radius"
Const strGReportTitleNominalSize = "Diameter"
Const strGReportTitlePartName = "Nom Pièce"
Const strGReportTitleMass = "Masse"
Const strGReportTitleMaterial = "Matériau"
Const strGReportTitleCOGX = "CdG X-coord"
Const strGReportTitleCOGY = "CdG Y-coord"
Const strGReportTitleCOGZ = "CdG Z-coord"
Const strGReportTitleDepX = "Départ X-coord"
Const strGReportTitleDepY = "Départ Y-coord"
Const strGReportTitleDepZ = "Départ Z-coord"
Const strGReportTitleEndX = "Fin X-coord"
Const strGReportTitleEndY = "Fin Y-coord"
Const strGReportTitleEndZ = "Fin Z-coord"
Dim intGReportCurrentRow As Integer
Dim intGReportCurrentColumn As Integer
'// ---------- User customizable sections
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'// ---------- Do not write over row 1, that's the header in the template
Const intGReportStartAfterRow = 2
Const intGReportStartAfterColumn = 0
'// ---------- EXCEL template direction path
Const strGReportTemplate ="C:\Users\nicolas\Desktop\test.xlsx"
'// ---------- Name the sheet in the template accordingly
Const strGReportEXCELSheetName = "Run Properties"
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'// ---------- CATIAV5 application objects
Dim objGCATIADocument0 As Document
Dim objGCATIASelection0 As Selection
Dim objGCATIAProduct0 As Product
Dim sel As Selection
'// ---------- EXCEL application objects
Dim objGEXCELApp 'As AnyObject
Dim objGEXCELWorkBooks 'As AnyObject
Dim objGEXCELWorkBook 'As AnyObject
Dim objGEXCELWorkSheets 'As AnyObject
Dim objGEXCELWorkSheet 'As AnyObject
'------------------------------------------------------------------------------
Sub WriteToEXCELRunSheet(iIntRow, iStrColumn, iStrValue)
Dim intWhichColumn As Integer
On Error Resume Next
intWhichColumn = 0
If (Len(iStrValue) > 0) Then
Select Case iStrColumn
Case strGReportTitleInstanceName
intWhichColumn = intGReportStartAfterColumn + 1
Case strGReportTitleNodeNumber
intWhichColumn = intGReportStartAfterColumn + 2
Case strGReportTitleNodeX
intWhichColumn = intGReportStartAfterColumn + 3
Case strGReportTitleNodeY
intWhichColumn = intGReportStartAfterColumn + 4
Case strGReportTitleNodeZ
intWhichColumn = intGReportStartAfterColumn + 5
Case strGReportTitleBlendRadius
intWhichColumn = intGReportStartAfterColumn + 6
Case strGReportTitleNominalSize
intWhichColumn = intGReportStartAfterColumn + 7
Case strGReportTitlePartName
intWhichColumn = intGReportStartAfterColumn + 8
Case strGReportTitleMass
intWhichColumn = intGReportStartAfterColumn + 9
Case strGReportTitleMaterial
intWhichColumn = intGReportStartAfterColumn + 10
Case strGReportTitleCOGX
intWhichColumn = intGReportStartAfterColumn + 11
Case strGReportTitleCOGY
intWhichColumn = intGReportStartAfterColumn + 12
Case strGReportTitleCOGZ
intWhichColumn = intGReportStartAfterColumn + 13
Case strGReportTitleDepX
intWhichColumn = intGReportStartAfterColumn + 14
Case strGReportTitleDepY
intWhichColumn = intGReportStartAfterColumn + 15
Case strGReportTitleDepZ
intWhichColumn = intGReportStartAfterColumn + 16
Case strGReportTitleEndX
intWhichColumn = intGReportStartAfterColumn + 17
Case strGReportTitleEndY
intWhichColumn = intGReportStartAfterColumn + 18
Case strGReportTitleEndZ
intWhichColumn = intGReportStartAfterColumn + 19
End Select
If (intWhichColumn > intGReportStartAfterColumn) Then
objGEXCELWorkSheet.Cells(iIntRow, intWhichColumn) = iStrValue
objGEXCELWorkSheet.Cells(iIntRow, intWhichColumn).Select
End If
End If
End Sub '////////////////////////////////////////////////////// WriteToEXCELRunSheet
'------------------------------------------------------------------------------
Sub InsertAnEXCELRowAt(iIntRow)
objGEXCELWorkSheet.Cells(iIntRow, 1).EntireRow.Select
objGEXCELApp.Selection.Insert
objGEXCELWorkSheet.Cells(iIntRow, 1).EntireRow.Select
End Sub '///////////////////////////////////////////////////////// InsertAnEXCELRowAt
'------------------------------------------------------------------------------
Sub StartEXCEL()
Err.Clear
On Error Resume Next
Set objGEXCELApp = GetObject(, "EXCEL.Application")
If AppExcel Is Nothing Then
Err.Clear
Set objGEXCELApp = CreateObject("EXCEL.Application")
End If
objGEXCELApp.Application.Visible = True
Err.Clear
Set objGEXCELWorkBooks = objGEXCELApp.Application.workbooks
Set objGEXCELWorkBook = objGEXCELWorkBooks.Add(strGReportTemplate)
If Err.Number <> 0 Then
MsgBox "Vérifiez que vous disposez de droits en lecture sur le fichier suivant :" & Chr(10) & strGReportTemplate, _
vbOkOnly + vbCritical, "Erreur de chargement du template Excel" + Err.Number
Exit Sub
End If
Set objGEXCELWorkSheets = objGEXCELWorkBook.Worksheets
Set objGEXCELWorkSheet = objGEXCELWorkSheets(strGReportEXCELSheetName)
intGReportCurrentColumn = intGReportStartAfterColumn
intGReportCurrentRow = intGReportStartAfterRow
objGEXCELWorkSheet.Select
Err.Clear
End Sub '/////////////////////////////////////////////////////////// StartEXCEL
'------------------------------------------------------------------------------
Sub EndEXCEL()
objGEXCELWorkBook.Close
objGEXCELApp.Quit
End Sub '///////////////////////////////////////////////////////////// EndEXCEL
'------------------------------------------------------------------------------
Sub StartCATIA()
Err.Clear
On Error Resume Next
'//---------- Get the active document
Set objGCATIADocument0 = CATIA.ActiveDocument
If Err.Number <> 0 Then
MsgBox "Vous devez avoir un document actif chargé en session !", _
vbOkOnly + vbCritical, "Erreur au chargement du modèle"
Exit Sub
End If
'//---------- Get current selection & root product
Set objGCATIASelection0 = objGCATIADocument0.Selection
Set objGCATIAProduct0 = objGCATIADocument0.Product
If objGCATIASelection0.Count = 0 Then
objGCATIASelection0.Search "(CATLndSearch.Part),all"
End If
Err.Clear
End Sub '/////////////////////////////////////////////////////////// StartCATIA
'------------------------------------------------------------------------------
Sub CATMain()
Dim objProduct As Part
Dim objProductMat As Part
Dim intNbParts As Integer
Dim i As Integer
Dim intNbEdges As Integer
Dim doc, sel, spa, ref, measurable
Dim inputObjectType(0)
Dim j As Integer
StartCATIA
If Err.Number <> 0 Then
Exit Sub
End If
StartEXCEL
If Err.Number <> 0 Then
Exit Sub
End If
intNbParts = objGCATIASelection0.Count
For i = 1 To intNbParts
Set objProduct = Nothing
Set objProductMat = Nothing
Set objProduct = objGCATIASelection0.Item(i).Value
Set objProductMat = objGCATIASelection0.Item(i)
Err.Clear
Dim objInertia As Inertia
On Error Resume Next
Set objInertia = objProduct.GetTechnologicalObject("Inertia")
Dim getMass As String
getMass = objInertia.Mass
Dim partName As String
partName = objProduct.Name
'Dim Mat As Material
'Dim oManager As MaterialManager
'Set oManager = objProductMat.GetItem("CATMatManagerVBExt")
'oManager.GetMaterialOnPart objProductMat.ReferenceProduct.Parent.Part,Mat
'matName = Mat.Name
Dim Coordinates(2)
objInertia.GetCOGPosition Coordinates
MsgBox intNbParts
Set sel = CATIA.ActiveDocument.Selection.Item(i)
Set spa = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
sel.Search "Topology.CGMEdge,all"
intNbEdges = sel.Count
MsgBox intNbEdges
For j = 1 To intNbEdges
Set myCircle = sel.Item(j)
If myCircle.Type = "TriDimFeatEdge" Then
Set ref = sel.Item(j).Reference
Set measurable = spa.GetMeasurable(ref)
Dim oCoordinates(2)
measurable.GetCenter oCoordinates
Dim Radius As Long
Radius = measurable.Radius
MsgBox "x = " & oCoordinates(0) & Chr(10) & "y = " & oCoordinates(1) & Chr(10) & "z = " & oCoordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
Err.Clear
End If
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, oCoordinates(0) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, oCoordinates(1) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, oCoordinates(2) & "mm"
Next
intGReportCurrentRow = intGReportCurrentRow + 1
InsertAnEXCELRowAt (intGReportCurrentRow)
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Coordinates(0) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Coordinates(1) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Coordinates(2) & "mm"
'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndX, oCoordinates(0) & "mm"
'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndY, oCoordinates(1) & "mm"
'WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndZ, oCoordinates(2) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName
Next
intGReportCurrentRow = intGReportCurrentRow + 1
InsertAnEXCELRowAt (intGReportCurrentRow)
End Sub '/////////////////////////////////////////////////////////// CATMain
Là dans ce cas là, il me donne pas les extrémités, mais il me donne les infos sur les pièces.
Mais quand je modifie la 2ème sélection pour faire une sélection globale, dans ce cas là, ça me sort les extrémités globales et ça me change les noms de la pièce dans le fichier excel
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Il y a effectivement un problème avec les sélections, ors du 2è passage dans la boucle i, la sélection des parts prend la valeur de la sélection des Edges.
J'ai donc supprimé cette sélection et utilisé les instances pour balayer les Parts (attention ne fonctionne pas si plusieurs niveaux).
Mais je rencontre de nouveaux PB:
-les mesures des coordonnées se font dans le repère pièce et non pas product
-comment dissocier le cercle de départ du cercle d'arrivé surtout si la part en a plus que 2 (voir Part3 de mon exemple).
Ci dessous le Catproduct exemple et le résultat excel:
Il y a effectivement un problème avec les sélections, ors du 2è passage dans la boucle i, la sélection des parts prend la valeur de la sélection des Edges.
J'ai donc supprimé cette sélection et utilisé les instances pour balayer les Parts (attention ne fonctionne pas si plusieurs niveaux).
Mais je rencontre de nouveaux PB:
-les mesures des coordonnées se font dans le repère pièce et non pas product
-comment dissocier le cercle de départ du cercle d'arrivé surtout si la part en a plus que 2 (voir Part3 de mon exemple).
Ci dessous le Catproduct exemple et le résultat excel:
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Salut Marc,
Merci pour ton analyse!
Pour l'instant je n'ai pas de problème de coordonnées: il me prend effectivement toutes les edges et pas celles de l'objet sélectionné, mais c'est dans le système assembly et non pas dans le système du part, donc peut être que ça doit venir de la sélection d'instances.
Pour ce qui est de plusieurs edges circulaires, effectivement, c'est problèmatique. Mais je n'enlève pas une possibilité de correction de ce problème dans la partie post-traitement, même à la main, si les erreurs sont limitées.
Dans mes assemblages, il y a des "té", donc je pourrais prendre un 3e jeu de coordonnées comme étant la branche sortant du té.
Et s'il y a plus (comme sur ta réduction), ça pourrait comprendre que c'est une pièce particulière qui serait en post-traitement.
Mon ultime recours serait de faire une sélection manuelle des edges sur chaque pièce, mais alors il faudrait faire un zoom sur pièce au moment de la sélection, et sur un assemblage de 200+ pièces, la selection manuelle serait d'un temps non négligeable...
Je suis vraiment bloqué sur cette sélection et je n'arrive pas à comprendre pourquoi il ne veut pas me faire 2 sélections distinctes...
Merci en tout cas de m'accorder ton temps
Merci pour ton analyse!
Pour l'instant je n'ai pas de problème de coordonnées: il me prend effectivement toutes les edges et pas celles de l'objet sélectionné, mais c'est dans le système assembly et non pas dans le système du part, donc peut être que ça doit venir de la sélection d'instances.
Pour ce qui est de plusieurs edges circulaires, effectivement, c'est problèmatique. Mais je n'enlève pas une possibilité de correction de ce problème dans la partie post-traitement, même à la main, si les erreurs sont limitées.
Dans mes assemblages, il y a des "té", donc je pourrais prendre un 3e jeu de coordonnées comme étant la branche sortant du té.
Et s'il y a plus (comme sur ta réduction), ça pourrait comprendre que c'est une pièce particulière qui serait en post-traitement.
Mon ultime recours serait de faire une sélection manuelle des edges sur chaque pièce, mais alors il faudrait faire un zoom sur pièce au moment de la sélection, et sur un assemblage de 200+ pièces, la selection manuelle serait d'un temps non négligeable...
Je suis vraiment bloqué sur cette sélection et je n'arrive pas à comprendre pourquoi il ne veut pas me faire 2 sélections distinctes...
Merci en tout cas de m'accorder ton temps
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Re: Extraction de points d'esquisse
Salut Nicolas,
Une autre proposition pour résoudre le problème de sélection : transférer la sélection de Part dans un tableau et utiliser ce tableau dans la boucle i à la place de la sélection (j'ai commenté les lignes modifiées avec '*ML*):
Pour différencier la première arrête de la deuxième (ou plus) j'ai rajouté une condition pour vérifier si le cercle appartient à la Part pour un compteur pour savoir si c'est le premier cercle de la Part. J'ai également modifié l'écriture d'Excel pour créer une ligne pour chaque cercle et arrondi les valeurs de coordonnées à 3 décimales:
Une autre proposition pour résoudre le problème de sélection : transférer la sélection de Part dans un tableau et utiliser ce tableau dans la boucle i à la place de la sélection (j'ai commenté les lignes modifiées avec '*ML*):
- Code:
StartEXCEL
If Err.Number <> 0 Then
Exit Sub
End If
'*ML* test tableau
intNbParts = objGCATIASelection0.Count
ReDim myPartArray(intNbParts - 1)
For k = 1 To intNbParts
'*ML*Set objProduct = objGCATIASelection0.Item(k) '.Value
Set myPartArray(k - 1) = objGCATIASelection0.Item(k).Value
Next k
For i = 1 To intNbParts
Set objProduct = Nothing
Set objProductMat = Nothing
'*ML*Set objProduct = objGCATIASelection0.Item(i).Value
'*ML*Set objProductMat = objGCATIASelection0.Item(i)
Set objProduct = myPartArray(i - 1) '*ML*
Err.Clear
Pour différencier la première arrête de la deuxième (ou plus) j'ai rajouté une condition pour vérifier si le cercle appartient à la Part pour un compteur pour savoir si c'est le premier cercle de la Part. J'ai également modifié l'écriture d'Excel pour créer une ligne pour chaque cercle et arrondi les valeurs de coordonnées à 3 décimales:
- Code:
EdgeNB = 1 '*ML*
'MsgBox intNbEdges
For j = 1 To intNbEdges
Set myCircle = sel.Item(j)
If myCircle.Type = "TriDimFeatEdge" Then
If myCircle.LeafProduct.Name = partName Then '*ML*
Set ref = sel.Item(j).Reference
Set measurable = spa.GetMeasurable(ref)
Dim oCoordinates(2)
measurable.GetCenter oCoordinates
Dim Radius As Long
Radius = measurable.Radius
'MsgBox partName & " x = " & oCoordinates(0) & Chr(10) & "y = " & oCoordinates(1) & Chr(10) & "z = " & oCoordinates(2) & Chr(10) & "Diametre = " & 2 * Radius
Err.Clear
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitlePartName, partName
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGX, Round(Coordinates(0), 3) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGY, Round(Coordinates(1), 3) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleCOGZ, Round(Coordinates(2), 3) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMass, getMass
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleMaterial, matName
If EdgeNB = 1 Then 'si premier cercle alors départ
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepX, Round(oCoordinates(0), 3) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepY, Round(oCoordinates(1), 3) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleDepZ, Round(oCoordinates(2), 3) & "mm"
Else 'sinon les cercles suivants dans colonnes Fin
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndX, Round(oCoordinates(0), 3) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndY, Round(oCoordinates(1), 3) & "mm"
WriteToEXCELRunSheet intGReportCurrentRow, strGReportTitleEndZ, Round(oCoordinates(2), 3) & "mm"
End If
intGReportCurrentRow = intGReportCurrentRow + 1
InsertAnEXCELRowAt (intGReportCurrentRow)
EdgeNB = EdgeNB + 1
End If '= "TriDimFeatEdge"
End If '= partName
Next j
Next i
End Sub '/////////////////////////////////////////////////////////// CATMain
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Extraction de points d'esquisse
Salut Marc!
Wow! Merci ça marche super bien! Effectivement, l'idée du tableau est super efficace! J'y avais pensé mais je ne savais pas comment le mettre en place!
J'ai également remarqué que faire une sélection au préalable permettait d'exécuter la macro juste sur les pièce sélectionnées, ce qui serait pratique pour une extraction locale exceptionnelle.
Je pense qu'il va falloir que je trouve un moyen pour limiter le nombre de sortie à 4 (nombre maximum de coordonnées pour un tuyau qui sera une réduction).
Donc je pense qu'il va falloir que je rajoute une condition dans la boucle
Wow! Merci ça marche super bien! Effectivement, l'idée du tableau est super efficace! J'y avais pensé mais je ne savais pas comment le mettre en place!
J'ai également remarqué que faire une sélection au préalable permettait d'exécuter la macro juste sur les pièce sélectionnées, ce qui serait pratique pour une extraction locale exceptionnelle.
Je pense qu'il va falloir que je trouve un moyen pour limiter le nombre de sortie à 4 (nombre maximum de coordonnées pour un tuyau qui sera une réduction).
Donc je pense qu'il va falloir que je rajoute une condition dans la boucle
Nico_atomique- actif
- Messages : 38
Date d'inscription : 19/04/2016
Localisation : Marseille/Aix-en-Provence
Sujets similaires
» Extraction, drafting et FTA
» Extraction des arêtes d'un maillage
» Macro pour extraction de certaines données
» essai post-processeur 5 axes table-table broche verticale - fanuc
» Importation des points d'un profil d'aile à l'aide d'une macros Excel
» Extraction des arêtes d'un maillage
» Macro pour extraction de certaines données
» essai post-processeur 5 axes table-table broche verticale - fanuc
» Importation des points d'un profil d'aile à l'aide d'une macros Excel
Page 1 sur 1
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum