Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations MintJulep on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!
Wanted to extract the values from geometrical set to excel
- Thread starter Sidtha
- Start date
- Thread starter
- #2
Below is code return in excel vba
Dim WS As Worksheet
Sub CATMain()
ThisWorkbook.Sheets("Sheet1").Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
Dim CATIA As Object
'Get CATIA or Launch it if necessary.
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
On Error GoTo 0
GetNextNode CATIA.ActiveDocument.Product
Application.StatusBar = ""
End Sub
Sub GetNextNode(oCurrentProduct As Product)
Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer
Dim LastRow As Long
Set WS = ThisWorkbook.Sheets("Sheet1")
' Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oparameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties
MyCurrParentPN = oCurrentTreeNode.PartNumber
StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
Application.StatusBar = oCurrentTreeNode.PartNumber
On Error Resume Next
' Determine if the current node is a part, product or component
If Mid(MyCurrParentPN, 15, 4) = "-STD" Then
LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
WS.Cells(LastRow, 1) = oCurrentTreeNode.PartNumbe
End If
'if sub-nodes exist below the current tree node, call the sub recursively
If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If
Next
End Sub
Function IsProduct(objCurrentProduct As Product) As Boolean
Dim oTestProduct As ProductDocument
Set oTestProduct = Nothing
On Error Resume Next
Set oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
If Not oTestProduct Is Nothing Then
IsProduct = True
Else
IsProduct = False
End If
End Function
Dim WS As Worksheet
Sub CATMain()
ThisWorkbook.Sheets("Sheet1").Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
Dim CATIA As Object
'Get CATIA or Launch it if necessary.
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
On Error GoTo 0
GetNextNode CATIA.ActiveDocument.Product
Application.StatusBar = ""
End Sub
Sub GetNextNode(oCurrentProduct As Product)
Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer
Dim LastRow As Long
Set WS = ThisWorkbook.Sheets("Sheet1")
' Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oparameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties
MyCurrParentPN = oCurrentTreeNode.PartNumber
StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
Application.StatusBar = oCurrentTreeNode.PartNumber
On Error Resume Next
' Determine if the current node is a part, product or component
If Mid(MyCurrParentPN, 15, 4) = "-STD" Then
LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
WS.Cells(LastRow, 1) = oCurrentTreeNode.PartNumbe
End If
'if sub-nodes exist below the current tree node, call the sub recursively
If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If
Next
End Sub
Function IsProduct(objCurrentProduct As Product) As Boolean
Dim oTestProduct As ProductDocument
Set oTestProduct = Nothing
On Error Resume Next
Set oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
If Not oTestProduct Is Nothing Then
IsProduct = True
Else
IsProduct = False
End If
End Function
- Thread starter
- #4
I do not see any code to extract parameters into excel sheet, as I see it you only extract part number, nothing else.
Tesak
- Play Tetris in CATIA V5 drawing
Tesak
- Play Tetris in CATIA V5 drawing
- Thread starter
- #6
Then please upload a sample product as it is really hard to do something meaningful without data.
Tesak
- Play Tetris in CATIA V5 drawing
Tesak
- Play Tetris in CATIA V5 drawing
- Thread starter
- #8
Below is my complete code written in VBA
In highlighted code its giving the results for all the data below the part, but i need the data only from the geometrical set like shown below.
Dim WS As Worksheet
Sub CATMain()
Application.ScreenUpdating = True
ThisWorkbook.Sheets("Sheet1").Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
Dim CATIA As Object
'Get CATIA or Launch it if necessary.
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
On Error GoTo 0
GetNextNode CATIA.ActiveDocument.Product
Application.StatusBar = ""
End Sub
Sub GetNextNode(oCurrentProduct As Product)
Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer
Dim LastRow As Long
Set WS = ThisWorkbook.Sheets("Sheet1")
' Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oparameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties
MyCurrParentPN = oCurrentTreeNode.PartNumber
StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
Application.StatusBar = oCurrentTreeNode.PartNumber
On Error Resume Next
' Determine if the current node is a part, product or component
If Mid(MyCurrParentPN, 15, 4) = "-STD" Then
' LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' WS.Cells(LastRow, 1) = MyCurrParentPN
Dim oCurrentTreeNodePart
Dim MBod
Set oCurrentTreeNodePart = oCurrentTreeNode.ReferenceProduct.Parent.Part
Debug.Print oCurrentTreeNodePart.Name
Set mBody = oCurrentTreeNodePart.MainBody
Debug.Print mBody.Name
Set objParameters = oCurrentTreeNodePart.Parameters
' Loop on parameters to retrieve them
[highlight #FCAF3E] For j = 1 To objParameters.Count
Set objParameter = objParameters.Item(j)
strParmName = objParameter.Name
Debug.Print strParmName
strParmValue = objParameter.ValueAsString
Debug.Print strParmValue
' MsgBox strParmName & " = " & strParmValue
Debug.Print strParmName & " = " & strParmValue
LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
WS.Cells(LastRow, 1) = MyCurrParentPN
WS.Cells(LastRow, 2) = strParmName & " = " & strParmValue
Next[/highlight]
End If
'if sub-nodes exist below the current tree node, call the sub recursively
If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If
Next
End Sub
Function IsProduct(objCurrentProduct As Product) As Boolean
Dim oTestProduct As ProductDocument
Set oTestProduct = Nothing
On Error Resume Next
Set oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
If Not oTestProduct Is Nothing Then
IsProduct = True
Else
IsProduct = False
End If
End Function
In highlighted code its giving the results for all the data below the part, but i need the data only from the geometrical set like shown below.
Dim WS As Worksheet
Sub CATMain()
Application.ScreenUpdating = True
ThisWorkbook.Sheets("Sheet1").Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A1").Select
Dim CATIA As Object
'Get CATIA or Launch it if necessary.
On Error Resume Next
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
Set CATIA = CreateObject("CATIA.Application")
CATIA.Visible = True
End If
On Error GoTo 0
GetNextNode CATIA.ActiveDocument.Product
Application.StatusBar = ""
End Sub
Sub GetNextNode(oCurrentProduct As Product)
Dim oCurrentTreeNode As Product
Dim StrNomenclature, StrDesignation, StrWindows As String
Dim i As Integer
Dim LastRow As Long
Set WS = ThisWorkbook.Sheets("Sheet1")
' Loop through every tree node for the current product
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
Set oparameters = oCurrentTreeNode.ReferenceProduct.UserRefProperties
MyCurrParentPN = oCurrentTreeNode.PartNumber
StrWindows = oCurrentTreeNode.ReferenceProduct.Parent.FullName
Application.StatusBar = oCurrentTreeNode.PartNumber
On Error Resume Next
' Determine if the current node is a part, product or component
If Mid(MyCurrParentPN, 15, 4) = "-STD" Then
' LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' WS.Cells(LastRow, 1) = MyCurrParentPN
Dim oCurrentTreeNodePart
Dim MBod
Set oCurrentTreeNodePart = oCurrentTreeNode.ReferenceProduct.Parent.Part
Debug.Print oCurrentTreeNodePart.Name
Set mBody = oCurrentTreeNodePart.MainBody
Debug.Print mBody.Name
Set objParameters = oCurrentTreeNodePart.Parameters
' Loop on parameters to retrieve them
[highlight #FCAF3E] For j = 1 To objParameters.Count
Set objParameter = objParameters.Item(j)
strParmName = objParameter.Name
Debug.Print strParmName
strParmValue = objParameter.ValueAsString
Debug.Print strParmValue
' MsgBox strParmName & " = " & strParmValue
Debug.Print strParmName & " = " & strParmValue
LastRow = WS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
WS.Cells(LastRow, 1) = MyCurrParentPN
WS.Cells(LastRow, 2) = strParmName & " = " & strParmValue
Next[/highlight]
End If
'if sub-nodes exist below the current tree node, call the sub recursively
If oCurrentTreeNode.Products.Count > 0 Then
GetNextNode oCurrentTreeNode
End If
Next
End Sub
Function IsProduct(objCurrentProduct As Product) As Boolean
Dim oTestProduct As ProductDocument
Set oTestProduct = Nothing
On Error Resume Next
Set oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
If Not oTestProduct Is Nothing Then
IsProduct = True
Else
IsProduct = False
End If
End Function
Sorry, but it is really hard to give you advice if we can't test it by ourselves.
Tesak
- Play Tetris in CATIA V5 drawing
Tesak
- Play Tetris in CATIA V5 drawing
- Thread starter
- #10
- Thread starter
- #11
- Status
Similar threads
- Locked
- Question
- Locked
- Question