récupérer tout les point d'un essemble (on me demande la solution rapidement help svp)
2 participants
Page 1 sur 1
récupérer tout les point d'un essemble (on me demande la solution rapidement help svp)
j'ai fait une macro pour avoir tout les point d'un ensemble, la macro me créer une fichier Excel par part
la macro ne me marque pas les point et leur coordonnée dans les fichier, je pense que mon erreur est ce que j'ai mis en rouge mais je le remplace par quoi ?
Dim objGEXCELapp As Object
Dim objGEXCELwkBks As Object
Dim objGEXCELwkBk As Object
Dim objGEXCELwkShs As Object
Dim objGEXCELSh As Object
Dim fs, f, f1, fc, s
Dim coords(2) As Integer
Dim PartDocument1
'******************************************************************************
Sub CATMain()
'******************************************************************************
On Error Resume Next
Dim myDoc As Document
Dim myrootProduct As Product
Set myDoc = CATIA.ActiveDocument
Set myrootProduct = myDoc.Product
Call visitProduct(myrootProduct, "")
End Sub
'******************************************************************************
Sub visitProduct(prod As Product, parentKey As String)
'******************************************************************************
On Error Resume Next
Dim children As Products
Set children = prod.Products
Dim i As Integer
Dim child As Product
Dim key As String
Dim label As String
label = prod.PartNumber & " / " & prod.Name ' pour afficher le pratNumber et le nom d'instance
key = parentKey & "###" & prod.Name
'===========================
'Récupère le nom de fichier:
nomFichier = prod.ReferenceProduct.Parent.Name
L = Len(prod.PartNumber)
'Si c'est un CATPart:
If InStr(nomFichier, "CATPart") > 0 Then
Dim mPart As Part
Set mPart = prod.ReferenceProduct.Parent.Part
mPart.Selection.Search "CATGmoSearch.Point,all"
StartEXCEL
ExportPoint
objGEXCELSh.Application.ActiveWorkbook.SaveAs (ExcelFolder & prod.partnumber & ".xls")
objGEXCELSh.Application.ActiveWorkbook.Close
End If
'===========================
For i = 1 To children.Count
Set child = children.Item(i)
Call visitProduct(child, key)
Next
End Sub
'******************************************************************************
Sub StartEXCEL()
'******************************************************************************
Err.Clear
On Error Resume Next
Set objGEXCELapp = GetObject (,"EXCEL.Application")
If Err.Number <> 0 Then
Err.Clear
Set objGEXCELapp = CreateObject ("EXCEL.Application")
End If
objGEXCELapp.Application.Visible = TRUE
Set objGEXCELwkBks = objGEXCELapp.Application.WorkBooks
Set objGEXCELwkBk = objGEXCELwkBks.Add
Set objGEXCELwkShs = objGEXCELwkBk.Worksheets(1)
Set objGEXCELSh = objGEXCELwkBk.Sheets (1)
objGEXCELSh.Cells (1,"A") = "Name"
objGEXCELSh.Cells (1,"B") = "X"
objGEXCELSh.Cells (1,"C") = "Y"
objGEXCELSh.Cells (1,"D") = "Z"
End Sub
'******************************************************************************
Sub ExportPoint()
'******************************************************************************
For i = 1 To mPart.Selection.Count
Set selection = mPart.Selection
Set element = selection.Item(i)
Set point = element.value
'Write PointData to Excel Sheet
point.GetCoordinates(coords)
objGEXCELSh.Cells (i+1,"A") = point.name
objGEXCELSh.Cells (i+1,"B") = coords(0)
objGEXCELSh.Cells (i+1,"C") = coords(1)
objGEXCELSh.Cells (i+1,"D") = coords(2)
Next
End Sub
la macro ne me marque pas les point et leur coordonnée dans les fichier, je pense que mon erreur est ce que j'ai mis en rouge mais je le remplace par quoi ?
Dim objGEXCELapp As Object
Dim objGEXCELwkBks As Object
Dim objGEXCELwkBk As Object
Dim objGEXCELwkShs As Object
Dim objGEXCELSh As Object
Dim fs, f, f1, fc, s
Dim coords(2) As Integer
Dim PartDocument1
'******************************************************************************
Sub CATMain()
'******************************************************************************
On Error Resume Next
Dim myDoc As Document
Dim myrootProduct As Product
Set myDoc = CATIA.ActiveDocument
Set myrootProduct = myDoc.Product
Call visitProduct(myrootProduct, "")
End Sub
'******************************************************************************
Sub visitProduct(prod As Product, parentKey As String)
'******************************************************************************
On Error Resume Next
Dim children As Products
Set children = prod.Products
Dim i As Integer
Dim child As Product
Dim key As String
Dim label As String
label = prod.PartNumber & " / " & prod.Name ' pour afficher le pratNumber et le nom d'instance
key = parentKey & "###" & prod.Name
'===========================
'Récupère le nom de fichier:
nomFichier = prod.ReferenceProduct.Parent.Name
L = Len(prod.PartNumber)
'Si c'est un CATPart:
If InStr(nomFichier, "CATPart") > 0 Then
Dim mPart As Part
Set mPart = prod.ReferenceProduct.Parent.Part
mPart.Selection.Search "CATGmoSearch.Point,all"
StartEXCEL
ExportPoint
objGEXCELSh.Application.ActiveWorkbook.SaveAs (ExcelFolder & prod.partnumber & ".xls")
objGEXCELSh.Application.ActiveWorkbook.Close
End If
'===========================
For i = 1 To children.Count
Set child = children.Item(i)
Call visitProduct(child, key)
Next
End Sub
'******************************************************************************
Sub StartEXCEL()
'******************************************************************************
Err.Clear
On Error Resume Next
Set objGEXCELapp = GetObject (,"EXCEL.Application")
If Err.Number <> 0 Then
Err.Clear
Set objGEXCELapp = CreateObject ("EXCEL.Application")
End If
objGEXCELapp.Application.Visible = TRUE
Set objGEXCELwkBks = objGEXCELapp.Application.WorkBooks
Set objGEXCELwkBk = objGEXCELwkBks.Add
Set objGEXCELwkShs = objGEXCELwkBk.Worksheets(1)
Set objGEXCELSh = objGEXCELwkBk.Sheets (1)
objGEXCELSh.Cells (1,"A") = "Name"
objGEXCELSh.Cells (1,"B") = "X"
objGEXCELSh.Cells (1,"C") = "Y"
objGEXCELSh.Cells (1,"D") = "Z"
End Sub
'******************************************************************************
Sub ExportPoint()
'******************************************************************************
For i = 1 To mPart.Selection.Count
Set selection = mPart.Selection
Set element = selection.Item(i)
Set point = element.value
'Write PointData to Excel Sheet
point.GetCoordinates(coords)
objGEXCELSh.Cells (i+1,"A") = point.name
objGEXCELSh.Cells (i+1,"B") = coords(0)
objGEXCELSh.Cells (i+1,"C") = coords(1)
objGEXCELSh.Cells (i+1,"D") = coords(2)
Next
End Sub
Dernière édition par quentinc le Mer 24 Aoû 2016 - 15:10, édité 1 fois
quentinc- actif
- Messages : 33
Date d'inscription : 07/06/2016
Localisation : saint quentin en yveline
Re: récupérer tout les point d'un essemble (on me demande la solution rapidement help svp)
bonjour,
Ta variable "mPart" est declarer dans Sub visitProduct(prod As Product, parentKey As String)
donc tu ne la recupère pas tu dois la sortir.
Mets la ligne Dim mPart As Part en haut de ton programme.
A+
raphael
Ta variable "mPart" est declarer dans Sub visitProduct(prod As Product, parentKey As String)
donc tu ne la recupère pas tu dois la sortir.
Mets la ligne Dim mPart As Part en haut de ton programme.
A+
raphael
raphael_59240- actif
- Messages : 127
Date d'inscription : 28/03/2015
Age : 53
Localisation : dunkerque
Page 1 sur 1
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum
|
|