Hallo,
ich wollte mal mein Makro zum Vergleichen aller PartNumbers InstanceNames und FileNames innerhalb eines Productes vorstellen.
Falls jemand noch eine Ahnung hat wie ich Components oder nicht geladene Teile abfangen kann bitte ergänzen.
Gruß Jasiu
'***************************************************************
'**** Macro "Find all Products and Parts"
'****
'---------------------------------------------------------------
'**** Purpose:
'**** Control part and file name. Original file name are taken from a ASCII-File
'---------------------------------------------------------------
'****
'**** Dev. Jasiu
'**** For professional using you should contact me! jasiu@gmx.ch
'**** Rev. Beta 0.1 - 28. May 2004
'****
'---------------------------------------------------------------
'**** CATScript help can be found at
'**** C:\Programme\CatiaV5RxSPx\intel_a\code\bin\V5Automation.chm
'**** VB-Script help can be found at
'**** http:gImsdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/vbscripttoc.asp
'***************************************************************
Option Explicit
Language="VBSCRIPT"
Function SplitString(oString As String, j As Integer) As Array
Dim oContArray As Array
Dim oTranString As String
Dim i As Integer
i = 1
Dim uContArray As Array
oContArray = Split(oString, chr(9), -1, 1) 'Split the String
uContArray = oContArray
If InStr(CStr(oContArray(i)), ".CAT") then
For i = 0 to j - 1
oTranString = CStr(oContArray(i))
uContArray = Split(oTranString, ".CAT", -1, 1)
If InStr(CStr(uContArray(0)), "/") then
Dim nPos As Integer
nPos = InStrRev(uContArray(0), "/")
If nPos > 0 Then
uContArray(0) = Mid(uContArray(0), nPos + 1)
End If
End If
oContArray(i) = uContArray(0)
Next
Else
For i = 0 to j - 1
On Error Resume Next
oTranString = CStr(oContArray(i))
uContArray = Split(oTranString, ".", -1, 1)
oContArray(i) = uContArray(0)
Next
End If
SplitString = oContArray
End Function
Function FullName(iProduct As Product, j As Integer, dSubString As String) As String
Dim oSubProducts As Product
Dim i As Integer
Dim oLevel as String
Dim oFullName As PartDocument
Dim Content As String
For i = 1 To iProduct.Products.Count
Set oSubProducts = iProduct.Products.Item(i)
'oSubProducts.ActivateDefaultShape 'set the node to active
'oSubProducts.ApplyWorkMode DESIGN_MODE 'load the componet into the design mode
On Error Resume Next
Content = oSubProducts.ReferenceProduct.Parent.FullName
'If Err.Number = -2147418113 Then
'Content = "Mismatch"
'End If
dSubString = dSubString & chr(9) & Content
j = j+1
If iProduct.Products.Count > 0 then
oLevel = FullName(oSubProducts, j, dSubString)
End If
Next
FullName = dSubString
End Function
Function PartNumber(iProduct As Product, j As Integer, dSubString As String) As String
Dim oSubProducts As Product
Dim i As Integer
Dim oLevel as String
Dim Error As Boolean
Dim Content As String
For i = 1 To iProduct.Products.Count
Set oSubProducts = iProduct.Products.Item(i)
oSubProducts.ActivateDefaultShape 'set the node to active
oSubProducts.ApplyWorkMode DESIGN_MODE 'load the componet into the design mode
On Error Resume Next
Content = oSubProducts.PartNumber
If Err.Number = -2147418113 Then
'MsgBox Err.Number
Content = "Mismatch"
End If
dSubString = dSubString & chr(9) & Content
j = j+1
If iProduct.Products.Count > 0 then
oLevel = PartNumber(oSubProducts, j, dSubString)
End If
Next
PartNumber = dSubString
End Function
Function Name(iProduct As Product, j As Integer, dSubString As String) As String
Dim oSubProducts As Product
Dim i As Integer
Dim oLevel as String
For i = 1 To iProduct.Products.Count
Set oSubProducts = iProduct.Products.Item(i)
oSubProducts.ActivateDefaultShape 'set the node to active
oSubProducts.ApplyWorkMode DESIGN_MODE 'load the componet into the design mode
dSubString = dSubString & chr(9) & oSubProducts.Name
j = j+1
If iProduct.Products.Count > 0 then
oLevel = Name(oSubProducts, j, dSubString)
End If
Next
Name = dSubString
End Function
Function CompareNumber(xContArray As String, yContArray As String, zContArray As String) As String
CompareNumber = "No"
If InStr(xContArray, yContArray) Then
Else
CompareNumber = "Yes"
End If
If InStr(xContArray, zContArray) Then
Else
CompareNumber = "Yes"
End If
If InStr(yContArray, zContArray) Then
Else
CompareNumber = "Yes ==> maybe a COMPONENT"
End If
If Len(xContArray) <> Len(yContArray) Then
CompareNumber = "Yes"
End If
If Len(xContArray) <> Len(zContArray) Then
CompareNumber = "Yes"
End If
If Len(yContArray) <> Len(zContArray) Then
CompareNumber = "Yes"
End If
If InStr(xContArray, "Mismatch") Then
CompareNumber = "Yes ==> Item not founded"
End If
End Function
Sub CATMain()
'------------------------------------------------
' Set environment
'------------------------------------------------
Dim sInputPath As CATBSTR
'sInputPath = "/usr/tmp"
'sInputPath = InputBox ("Enter path to the input directory from product", "Input File", sInputPath)
sInputPath = CATIA.FileSelectionBox("FileOpen", "*.CATProduct", CATFileSelectionModeOpen)
Dim oPartDocument As ProductDocument
Set oPartDocument = CATIA.Documents.Open(sInputPath)
Dim oProduct As Product
Dim oSubProducts As Product
Dim k As Integer
k = 1
Dim j As Integer
j = 1
Dim l As Integer
l = 1
Dim oStructure As String
Dim oFullName As String
Dim nContArray As Array
Dim iContArray As Array
Dim fContArray As Array
Set oProduct = oPartDocument.Product
oStructure = PartNumber(oProduct, j, oProduct.PartNumber)
nContArray = SplitString(oStructure, j)
oStructure = Name(oProduct, l, oProduct.Name)
iContArray = SplitString(oStructure, l)
oFullName = FullName(oProduct, k, oProduct.ReferenceProduct.Parent.FullName)
fContArray = SplitString(oFullName, k)
Call TextFileFill(nContArray, iContArray, fContArray, j)
End Sub
Private Sub TextFileFill(xContArray As Array, yContArray As Array, zContArray As Array, n As Integer)
Dim sResFilePath As CATBSTR
sResFilePath = "/home/results.log" 'output directory
'sResFilePath = InputBox ("Enter path to the log file", "Input File", sResFilePath)
'sResFilePath = CATIA.FileSelectionBox("Save log-file as", "*.log", CatFileSelectionModeSave)
Dim oFileSys as FileSystem
Set oFileSys = CATIA.FileSystem
Dim sResultsFile As File
Set sResultsFile = oFileSys.CreateFile(sResFilePath, true)
Dim oWriteStream As TextStream
Set oWriteStream = sResultsFile.OpenAsTextStream("ForWriting")
Dim c As Integer
c = 1
Dim cContents As String
Dim oErrorMassage As String
oWriteStream.Write chr(9) & "PartNumber" & chr(9) & "ItemName" & chr(9) & "FileName" & chr(9) & "Errors" & chr(10) & chr(10)
For c = 0 To n -1
oErrorMassage = CompareNumber(CStr(xContArray(c)), yContArray(c), zContArray(c))
cContents = CStr(xContArray(c)) & chr(9) & CStr(yContArray(c)) & chr(9) & CStr(zContArray(c)) & chr(9) & oErrorMassage
oWriteStream.Write CStr(c + 1) & chr(9) & cContents & chr(10)
Next
End Sub
[Diese Nachricht wurde von Jasiu am 15. Okt. 2004 editiert.]
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP