---

04_BOM_Check.CATScript.txt

Hi ich versuche ein Makro zu schreiben, welches die Benennungen aller
Parts und Products in einem Assembly prüfen soll. Die Elemente bei
denen die Benennungen nicht stimmen sollen in eine txt.Datei
geschrieben werden.

Die Prüfung funktioniert wunderbar.
Die Erstellung der txt.Datei mit einem Schriftkopf funktioniert auch.

Das aktuelle Problem ist die Übergabe der Funde an die Sub, welche die
falschen Namen in die txt.Datei schreiben soll.
Das zukünftige Problem wird sein, das mir das Makro die Namen mehrfach
ausgeben wird (sogar häufiger als das Element_X überhaupt verbaut ist)
Vermutlich werden die Elemente einfach mehrfach durchlaufen.

Vielleicht weiß ja jemand was zu beiden Problemen 
Im Anhang befindet sich das Script (Pfad der txt muss angepasst
werden, da ich noch nichts automatisiert habe.)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo shoutz,

ich hab die angehängte Text-Datei auf- und gleich wieder zugemacht.
Denkst Du wirklich, dass jemand sich erst die Mühe machen mag Deinen Code so zu formatieren, dass er lesbar wird?

Probier's mal mit dem 'Code'-Link links in der Leiste.
Und mit der Vorschau.

Tschau,
Joe

------------------
The problem with the world is that the intelligent people are full of doubts, while the stupid ones are full of confidence.
~Charles Bukowski

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

    
Sorry hätte ich vielleicht dazu schreiben sollen.
Das ist ein CatScript. Das .txt am End musst Du löschen dann kannst
Du es direkt in Catia öffnen. Ich konnte das CatScript nicht hochladen
deshalb habe ich das .txt angehängt. Unter Catia ist die Struktur dann
natürlich vernünftig  

[Diese Nachricht wurde von shoutz000 am 15. Aug. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo shoutz,

die Anweisung

Code:

---

DataExport oProd

---

kann so nicht funktionieren, weil

Code:

---

Sub DataExport(oProd, oFile)

---

zwei Parameter beim Aufruf erwartet.

Entweder löscht Du den 'oFile' aus der Sub-Definition
oder Du gibst den Filenamen beim Aufruf mit an.

Was mich irritiert:
Du schreibst sehr lange Zeilen. Üblich war, zu TSO/Terminal-Zeiten
Zeilen mit 80 Zeichen oder 72 + Zeilennummer zu schreiben;
in jedem Fall aber alle Zeilen gleich lang.
Dann klappt auch die Ascii-Grafik besser.

Just a thought,
Joe

------------------
The problem with the world is that the intelligent people are full of doubts, while the stupid ones are full of confidence.
~Charles Bukowski

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,
am besten ist, du schaufelst den Catia Baum erst einmal komplett in ein Array.
(Alle Dokument-Instanzen des aktiven Products in ein Array schaufeln (über Selection Search)

Danach kannst du doppelte Einträge aus dem Array rausschmeißen.

Jetzt könntest du dieses Array auf fehlerhafte Namensgebung untersuchen, und wenn ein Fehler gefunden wurde dieses in die *.txt datei schreiben
Und so könnte es aufgebaut sein:

Code:

---

Language="VBSCRIPT"
public DokAnzahl
public strPartNumberArray()
public DoppelteRausArray()
public Fehler As Sting

Sub CATMain()
   CatiaBaumInArray
     if Fehler = "KeinProduct" Then
       exit sub
     end if
   DoppeltArrayRaus
   ArrayUntersuchUndInTxtDatei
end sub

'++++++++++++++++++++++++++++++++++++++++ Catia-Baum-in-Array Start ++++++++++++++++++++++++++++++++
Sub CatiaBaumInArray()
'on Error resume Next
If TypeName(CATIA.ActiveDocument) <> "ProductDocument"  then
  MsgBox "Das Active Dokument ist kein Pruduct" & vbCr _
          & "Bitte oeffen Sie ein Pruduckt" _
         ,vbOKOnly + vbCritical, "Abbruch"

   Fehler = "KeinProduct"
  exit sub
end if
  EingabeSuchMode = 1
  Call GetElements(EingabeSuchMode)  '1 = Parts und Products; 2 = nur Parts; 3 = nur Products
End Sub

Sub GetElements(SearchMode)
' Benötigt !!! Variable: public DokAnzahl: public strPartNumberArray()
' Eingabewerte: 1 = Parts und Products; 2 = nur Parts; 3 = nur Products
if SearchMode = 1 then SuchString = "Type=Product,all"
if SearchMode = 2 then SuchString = "(CATProductSearch.Part),all"
if SearchMode = 3 then SuchString = "(CATProductSearch.Assembly),all"
set Selection1 = CATIA.ActiveDocument.Selection
selection1.Search SuchString
DokAnzahl = selection1.Count
for n = 1 to DokAnzahl
   on Error Resume Next
   sPartNumber = selection1.Item(n).Value.ReferenceProduct.Name 'PartNumber
   'DateiName = selection1.Item(n).Value.ReferenceProduct.Parent.Name
   'DateiPfad = selection1.Item(n).Value.ReferenceProduct.Parent.Fullname
   ReDim Preserve strPartNumberArray(n)
   strPartNumberArray(n) = sPartNumber
next
selection1.Clear
End Sub
'+++++++++++++++++++++++++++++++++++++++++ Catia-Baum-in-Array ende ++++++++++++++++++++++++++++++++

Sub DoppeltArrayRaus()
For Count1 = 1 To UBound(strPartNumberArray)
  Varic = strPartNumberArray(Count1)
   If InStr(VariN, Varic) > 0 Then
    Else
     VariN = CStr(VariN) & "," & CStr(Varic)
     VariNAnz = VariNAnz + 1
      If Left(VariN, 1) = "," Then
        VariN = Right(VariN, Len(VariN) - 1)
      End If
   End If
Next

ReDim Preserve DoppelteRausArray(VariNAnz - 1)

For Count2 = 0 To VariNAnz - 1
  If InStr(VariN, ",") > 0 Then
   DoppelteRausArray(Count2) = Left(VariN, InStr(VariN, ",") - 1)
   VariN = Right(VariN, Len(VariN) - InStr(VariN, ","))
  Else
   DoppelteRausArray(Count2) = VariN
  End If
Next
end Sub

Sub ArrayUntersuchUndInTxtDatei()
For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)
  msgbox DoppelteRausArray(i)
next
end Sub

---

------------------
Sei Schlau bleib Dumm !!?!!

[Diese Nachricht wurde von K.Siebert am 17. Aug. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi vielen Dank euch 

@joehz: Was meinst Du genau mit der Zeilenlänge? Die in denen ich
den Schriftkopf erstelle? Im Editor passt das perfekt nur in Catia
werden die Zeilen anderst dargestellt. Ich habe daher den Schriftkopf
im Editor erstellt so wie ich ihn haben möchte und habe diesen dann
Zeile für Zeile in Catia eingefügt. Wie Catia das interpretiert ist mir
ja letzendlich egal hauptsache in der Ausgabedatei sieht es vernünftig
aus. Oder verstehe ich Dich falsch?

@K.Siebert: Vielen Dank das funktioniert schon eher  . Von der Seite
habe ich mir auch schon einige Tipps geholt...
Also die erste falsch benannte Datei wurde übertragen und dann hängt
sich das Makro auf... Wie entferne ich ein Element welches die
Prüfung bestanden hat aus der Array?! Wie bei der Selection
funktioniert es schon mal nicht...
So mein aktueller Stand:

Frage: Wieso kann der Sub weiterarbeiten? Du übergibst doch garnicht
die Array aus dem Vorherigen Sub?! Sry bin noch nicht sonderlich
versiert in der Hinsicht.

Code:

---

Sub ArrayUntersuchUndInTxtDatei()
For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)

Counter = 0

If Mid(DoppelteRausArray(i), 9, 1)="-" AND Mid(DoppelteRausArray(i), 11, 1)="-" AND Mid(DoppelteRausArray(i), 14, 1)="_" AND Mid(DoppelteRausArray(i), 18, 1)="_" AND Mid(DoppelteRausArray(i), 23, 1)="_" Then
DoppelteRausArray(i).Remove
End If
If Mid(DoppelteRausArray(i), 9, 1)="-" AND Mid(DoppelteRausArray(i), 11, 1)="-" AND Mid(DoppelteRausArray(i), 14, 1)="_" AND Mid(DoppelteRausArray(i), 17, 1)="_" AND Mid(DoppelteRausArray(i), 22, 1)="_" Then
DoppelteRausArray(i).Remove
End If
If Mid(DoppelteRausArray(i), 9, 1)="-" AND Mid(DoppelteRausArray(i), 11, 1)="-" AND Mid(DoppelteRausArray(i), 14, 1)="_" AND Mid(DoppelteRausArray(i), 17, 1)="_" AND Mid(DoppelteRausArray(i), 22, 1)="_" AND Mid(DoppelteRausArray(i), 26, 1)="_" Then
DoppelteRausArray(i).Remove
Else

Counter = Counter + 1

If Counter = 1 Then
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile("C:\Users\XXX\Desktop\TEST.txt", True)

'Schriftkopf erstellen
oFile.WriteBlankLines 1
oFile.WriteLine "==============================================================ErrorLog======================================================================="
oFile.WriteLine "    Projekt:    " & "ProjektName"
...
...
...
...
oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                                                  = "
oFile.WriteLine "============================================================================================================================================="
oFile.WriteBlankLines 1

'Fehler übertragen
oFile.WriteLine "  ***  " & DoppelteRausArray(i) & bCrLf
End If
End If
Next
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Element aus einem Array löschen siehe zB hier. Oder ggf auf eine Collection umsteigen.
Zur Frage: "Wieso kann der Sub weiterarbeiten?".
K.Siebert arbeitet an dieser Stelle mit globalen Objekten/Variablen. Auf diese können alle Funktionen und Routinen zugreifen.
IMHO sollte diese Methode sparsam verwendet werden (Code wird unübersichtlich, Variablennamen arten aus, Code ist nicht einfach weiterverwendbar).

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus Danke schon mal für das bisher.

ich denk das mit dem löschen funktioniert zumindest kommt kein Fehler
mehr  . Probleme habe ich nun mit dem Daten schreiben. Ich benötige
glaube ich nur einen Zeilenumbruch, da zur Zeit nicht mehr der erste
Fehler sondern der letzte in der txt-Datei steht.

So der Stand:

Code:

---

Sub ArrayUntersuchUndInTxtDatei()
For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)

        Counter = 0

    If Mid(DoppelteRausArray(i), 9, 1)="-" AND Mid(DoppelteRausArray(i), 11, 1)="-" AND Mid(DoppelteRausArray(i), 14, 1)="_" AND Mid(DoppelteRausArray(i), 18, 1)="_" AND Mid(DoppelteRausArray(i), 23, 1)="_" Then
        DoppelteRausArray(i) = DoppelteRausArray(i -1)
    End If
    If Mid(DoppelteRausArray(i), 9, 1)="-" AND Mid(DoppelteRausArray(i), 11, 1)="-" AND Mid(DoppelteRausArray(i), 14, 1)="_" AND Mid(DoppelteRausArray(i), 17, 1)="_" AND Mid(DoppelteRausArray(i), 22, 1)="_" Then
        DoppelteRausArray(i) = DoppelteRausArray(i -1)
    End If
    If Mid(DoppelteRausArray(i), 9, 1)="-" AND Mid(DoppelteRausArray(i), 11, 1)="-" AND Mid(DoppelteRausArray(i), 14, 1)="_" AND Mid(DoppelteRausArray(i), 17, 1)="_" AND Mid(DoppelteRausArray(i), 22, 1)="_" AND Mid(DoppelteRausArray(i), 26, 1)="_" Then
        DoppelteRausArray(i) = DoppelteRausArray(i -1)
    Else

        Counter = Counter + 1
    End If
    Next

If Counter <> 0 Then
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.CreateTextFile("C:\Users\XXX\Desktop\TEST.txt", True)

    'Schriftkopf erstellen
        oFile.WriteBlankLines 1
        oFile.WriteLine "==============================================================ErrorLog======================================================================="
        oFile.WriteLine "    Projekt:    " & "ProjektName"
        oFile.WriteLine "      Datum:    " & CStr(Date)
        oFile.WriteLine "    Uhrzeit:    " & CStr(Time)
        oFile.WriteLine "  Ersteller:    " & CATIA.SystemService.Environ("USERNAME")
        oFile.WriteLine "============================================================================================================================================="
        ...
        ...
        ...
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                                                  = "
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteBlankLines 1
End If
    oFile.WriteLine "  ***  " & DoppelteRausArray(i -1)
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Was mir an deinem Code sonderbar vorkommt (die ganzen If-Bediungen kann ich nicht nachvollziehen):
Fehlt nicht zum einfügen der Fehler eine Schleife, sonst wird diese Zeile nur einmal ausgeführt. zB:

Code:

---

For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)
    oFile.WriteLine "  ***  " & DoppelteRausArray(i)
next

---

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ja wie soll ich denn sonst die Benennungen Prüfen?
Ich habe es so versucht, aber da macht das Makro nicht mit:

If
XXX AND XXX AND XXX OR
XXX AND XXX AND XXX Then
...
...
End If

Dadurch das ich es in die If's unterteilt habe läuft das Ganze.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

BOM_Check.txt

Hi vielen Dank dafür 

also es ist aber weiterhin ein wenig komisch,

bei Baugruppen die nahzu der Benennung entsprechen kommt der Fehler:
Index außerhalb des Bereichs und zwar hier:
DoppelteRausArray(i) = DoppelteRausArray(i -1)

Baugruppen die völlig anderst sind (In Catia eingefügt und Namen belassen also Part1 / Product1 / ...)
laufen sauber durch und werden auch alle nur 1x ausgegeben.

Baugruppen welche der Benennung entsprechen und nur ein paar Fehler enthalten, laufen auch sauber durch,
aber alle fehlerhaften Elemente sind mehrfach in der txt-Datei aufgelistet 
Also ein Bauteil ist 4x verbaut wird in der txt aber 38x aufgelistet...

(Das st jetzt wirklich eine txt-Datei  )

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,
Diese Syntax ist niO
DoppelteRausArray(i) = DoppelteRausArray(i -1)

IMHO wirst du nach diesen Abfragen immer einen Fehler finden.
Hier Untersuchst du das Array(i) 3x und jede IF THEN steht für sich alleine.

IF xxx Then
AAA
Else
BBB
End If

Dieses Ist ein geschlossener Kreis. Somit hat du bei jeder IF immer nur 2 Möglichkeiten, Richtig oder Falsch.
Deswegen muss jeder Untersuchung neu entschieden werden

In etwa so:  (leider wird Untersuchung3 durch Untersuchung2 erschlagen, hier habe leider keine Idee zu diesem Problem.)

Code:

---

Sub CATMain()
'MsgBox "" & ""

ArrayUntersuchUndInTxtDatei()
End Sub

Sub ArrayUntersuchUndInTxtDatei()
Dim DoppelteRausArray(5)

DoppelteRausArray(0) = "00000000-0-AA_BBB_CCCC_0"
DoppelteRausArray(1) = "00000000-0-AA_BB_CCCC_1"
DoppelteRausArray(2) = "00000000-0-AA_BB_CCCC_DDD_2"

DoppelteRausArray(3) = "0000000-0-AA_BB_CCCCC_3"
DoppelteRausArray(4) = "00000000-0-A_BBB_CCCCC_4"
DoppelteRausArray(5) = "00000000-0-AA_BB_CCCCC_DD_5"

Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.CreateTextFile("D:\Catia-macros\" & "TEST" & ".txt", True)

    'Schriftkopf erstellen
        oFile.WriteBlankLines 1
        oFile.WriteLine "==============================================================ErrorLog======================================================================="
        oFile.WriteLine "    Projekt:    " & "ProjektName"
        oFile.WriteLine "      Datum:    " & CStr(Date)
        oFile.WriteLine "    Uhrzeit:    " & CStr(Time)
        oFile.WriteLine "  Ersteller:    " & CATIA.SystemService.Environ("USERNAME")
        oFile.WriteLine "============================================================================================================================================="
        '...
        '...
        '...
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                                                  = "
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteBlankLines 1

For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)

        Counter = 0

  strKennung1 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 18, 1)="_" AND _
Mid(DoppelteRausArray(i), 23, 1)="_"

'msgbox strKennung2 & "  " & DoppelteRausArray(i)
if strKennung1 = True Then
Counter = 0
Msgbox "iO1" & "  "& DoppelteRausArray(i)
Else
Counter = 11
Msgbox "niO1" & "  "& DoppelteRausArray(i)
end if

if Counter = 11 Then
strKennung2 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 17, 1)="_" AND _
Mid(DoppelteRausArray(i), 22, 1)="_"

'msgbox strKennung2 & "  " & DoppelteRausArray(i)
if strKennung2 = True Then
Counter = 0
Msgbox "iO2" & "  "& DoppelteRausArray(i)
Else
Counter = 22
Msgbox "niO2" & "  "& DoppelteRausArray(i)
end if
end if

if Counter = 22 Then
strKennung3= Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 17, 1)="_" AND _
Mid(DoppelteRausArray(i), 22, 1)="_" AND _
Mid(DoppelteRausArray(i), 26, 1)="_"

msgbox strKennung3 & " 3  " & DoppelteRausArray(i)
if strKennung3 = True Then
Counter = 0
Msgbox "iO3" & "  "& DoppelteRausArray(i)
Else
Counter = 33
Msgbox "niO3" & "  "& DoppelteRausArray(i)
end if
end if

If Counter <> 0 Then

oFile.WriteLine "  ***  " & DoppelteRausArray(i)
End If

    Next
End Sub

---

------------------
Sei Schlau bleib Dumm !!?!!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Array_Fall_Unterscheidung.jpg

Ich noch mal,

Denke habe es geloest.Durch eine zusätzliche Abfrage rutscht Array2 in Abfrage3

und hier die Lösung:

Code:

---

Sub CATMain()
'MsgBox "" & ""

ArrayUntersuchUndInTxtDatei()
End Sub

Sub ArrayUntersuchUndInTxtDatei()
Dim DoppelteRausArray(5)

DoppelteRausArray(0) = "00000000-0-AA_BBB_CCCC_0"
DoppelteRausArray(1) = "00000000-0-AA_BB_CCCC_1"
DoppelteRausArray(2) = "00000000-0-AA_BB_CCCC_DDD_2"

DoppelteRausArray(3) = "0000000-0-AA_BB_CCCCC_3"
DoppelteRausArray(4) = "00000000-0-A_BBB_CCCCC_4"
DoppelteRausArray(5) = "00000000-0-AA_BB_CCCCC_DD_5"

Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.CreateTextFile("D:\Catia-macros\" & "TEST" & ".txt", True)

    'Schriftkopf erstellen
        oFile.WriteBlankLines 1
        oFile.WriteLine "==============================================================ErrorLog======================================================================="
        oFile.WriteLine "    Projekt:    " & "ProjektName"
        oFile.WriteLine "      Datum:    " & CStr(Date)
        oFile.WriteLine "    Uhrzeit:    " & CStr(Time)
        oFile.WriteLine "  Ersteller:    " & CATIA.SystemService.Environ("USERNAME")
        oFile.WriteLine "============================================================================================================================================="
        '...
        '...
        '...
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                                                  = "
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteBlankLines 1

For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)

        Counter = 0

  strKennung1 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 18, 1)="_" AND _
Mid(DoppelteRausArray(i), 23, 1)="_"

'msgbox strKennung2 & "   " & DoppelteRausArray(i)
if strKennung1 = True Then
Counter = 0
Msgbox "iO1" & "   "& DoppelteRausArray(i)
Else
Counter = 11
Msgbox "niO1" & "   "& DoppelteRausArray(i)
end if

if Counter = 11 Then
strKennung2 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 17, 1)="_" AND _
Mid(DoppelteRausArray(i), 22, 1)="_"

'msgbox strKennung2 & "   " & DoppelteRausArray(i)
if strKennung2 = True Then
Counter = 0
Msgbox "iO2" & "   "& DoppelteRausArray(i)

UterSuch3 = split(DoppelteRausArray(i),"_")
'UnterSuchAnz2 = Len(UterSuch3(2))
UnterSuchAnz3 = Len(UterSuch3(3))
'MsgBox "Anz"& UnterSuchAnz2 & " " & UterSuch3(2) & vbCr& _
' "Anz" & UnterSuchAnz3 & " " & UterSuch3(3)
if UnterSuchAnz3 = "3" Then
Counter = 22
end if
Else
Counter = 22
Msgbox "niO2" & "   "& DoppelteRausArray(i)
end if
end if

if Counter = 22 Then
strKennung3= Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 17, 1)="_" AND _
Mid(DoppelteRausArray(i), 22, 1)="_" AND _
Mid(DoppelteRausArray(i), 26, 1)="_"

'msgbox strKennung3 & " 3  " & DoppelteRausArray(i)
if strKennung3 = True Then
Counter = 0
Msgbox "iO3" & "   "& DoppelteRausArray(i)
Else
Counter = 33
Msgbox "niO3" & "   "& DoppelteRausArray(i)
end if
end if

If Counter <> 0 Then

oFile.WriteLine "  ***  " & DoppelteRausArray(i)
End If

    Next
End Sub

---

------------------
Sei Schlau bleib Dumm !!?!!

[Diese Nachricht wurde von K.Siebert am 22. Aug. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

BOM_Check.txt

Hey super vielen Dank.
So richtig verstehe ich Dein Script jedoch nicht und es werden nur Werte aus deiner ersten Array ausgegeben z.B.:
  ***  0000000-0-AA_BB_CCCCC_3
  ***  00000000-0-A_BBB_CCCCC_4
  ***  00000000-0-AA_BB_CCCCC_DD_5

Ich habe das Makro aber inzwischen nach Deinem Script etwas modifiziert und angepasst (siehe txt). Es läuft fehlerfrei durch und gibt alles aus so wie es sein soll.
Problem ist weiterhin das einige Elemente mehrfach ausgegeben werden. Das liegt meiner Meinung nach daran:

Die Array hat eine bestimmt Größe und durch (DoppelteRausArray(i) = DoppelteRausArray(i-1)) wird das Element welches die Prüfung bestanden hat nicht mehr
ausgegeben. Da Aber die größe der Array gleich bleibt, werden alle fehlerhaften Elemente so oft ausgegeben bis die größe der Array abgearbeitet wurde.

Es muss statt (DoppelteRausArray(i) = DoppelteRausArray(i-1)) also nur eine Möglichkeit geschaffen werden um die Elemente aus der Array zu löschen und die
Array zu verkleinern. Dann läuft alles exakt so wie es soll! So wie das Makro jetzt aufgebaut ist, ist es sehr gut und schnell anpassbar, was wichtig ist,
da es auf alle OEM's angepasst werden soll und die Benennungen der OEM's sind zum Teil bedeutend komplexer zum prüfen.

Die aktuell zu prüfenden Benennungen sehen wie folgt aus:

Code:

---

Projekt-Baugruppe:   20150000-3-01_ZB_0000_NAME              Bereich Pos.Nr.: 0000
Adapter:             20150000-3-01____0000_ADAPTER           Bereich Pos.Nr.: 0000
Haupt-Baugruppe:     20150000-3-01_BG_1000_NAME              Bereich Pos.Nr.: 1000 - 9900
Adapter:             20150000-3-01____1000_ADAPTER           Bereich Pos.Nr.: 1000 - 9900
Unter-Baugruppe:     20150000-3-01_BG_1001_NAME              Bereich Pos.Nr.: 1001 - 1099
Sammel-Baugruppe:    20150000-3-01_BG_9999_SAMMLER           Bereich Pos.Nr.: 9999
Schweißteil:         20150000-3-01_SG_0001_NAME              Bereich Pos.Nr.: 0001 - 0100
                     20150000-3-01_ET_0001_0001_NAME         Bereich Pos.Nr.: 0001_0001 - 0001_9999
Einzelteil:          20150000-3-01_ET_0101_NAME              Bereich Pos.Nr.: 0101 - 0550
Kaufteil:            20150000-3-01_KT_0551_NAME              Bereich Pos.Nr.: 0551 - 0850
Normteil:            20150000-3-01_NT_0851_NAME              Bereich Pos.Nr.: 0851 - 0999

---

[Diese Nachricht wurde von shoutz000 am 30. Aug. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich versuch mal noch so ein paar sachen... 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Was mich bei dem Code wundert:
1. in der Routine "DoppeltArrayRaus":
- was soll die Routine machen? (kann den Code nicht nachvollziehen) Doppelte Elemente entfernen?
- das Array wird von vorne nach hinten durchsucht, falls die Prüfung positiv ist wird das letzte Element aus dem Array geschmissen (ReDim) obwohl es noch nicht untersucht wurde.
- ich würde entweder das Array von Hinten nach vorne untersuchen oder einen zweiten Array füllen (bei ersten Auftauchen eines Eintrags)

2. bei "ArrayUntersuchUndInTxtDatei"
Was soll dort die Zeile "DoppelteRausArray(i) = DoppelteRausArray(i-1)" dadurch kommt doch dieser Wert dann doppelt vor
Ich würde auch hier einen Array (oder Collection) erstellen die die fehlerhaften Einträge enthält (ist auch zum Zählen einfacher)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Wenn ich jetzt noch wüsste wie...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,
@bgrittmann

Zitat:

---

1. in der Routine "DoppeltArrayRaus":
- was soll die Routine machen? (kann den Code nicht nachvollziehen) Doppelte Elemente entfernen?

---

Ja

@shoutz000

Zitat:

---

es werden nur Werte aus deiner ersten Array ausgegeben

---

?
Es gibt nur ein Array

den rest solltest du hinbekommen.

Code:

---

Sub CATMain()
'MsgBox "" & ""

ArrayUntersuchUndInTxtDatei()
End Sub

Sub ArrayUntersuchUndInTxtDatei()

Dim DoppelteRausArray(5)

DoppelteRausArray(0) = "00000000-0-AA_BBB_CCCC_0"
DoppelteRausArray(1) = "00000000-0-AA_BB_CCCC_1"
DoppelteRausArray(2) = "00000000-0-AA_BB_CCCC_DDD_2"

DoppelteRausArray(3) = "0000000-0-AA_BB_CCCCC_3"
DoppelteRausArray(4) = "00000000-0-A_BBB_CCCCC_4"
DoppelteRausArray(5) = "00000000-0-AA_BB_CCCCC_DD_5"

Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.CreateTextFile("D:\Catia-macros\" & "TEST" & ".txt", True)

    'Schriftkopf erstellen
        oFile.WriteBlankLines 1
        oFile.WriteLine "==============================================================ErrorLog======================================================================="
        oFile.WriteLine "    Projekt:    " & "ProjektName"
        oFile.WriteLine "      Datum:    " & CStr(Date)
        oFile.WriteLine "    Uhrzeit:    " & CStr(Time)
        oFile.WriteLine "  Ersteller:    " & CATIA.SystemService.Environ("USERNAME")
        oFile.WriteLine "============================================================================================================================================="
        '...
        '...
        '...
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                                                  = "
        oFile.WriteLine "============================================================================================================================================="
        oFile.WriteBlankLines 1
n = n-1
For i = LBound(DoppelteRausArray) to UBound(DoppelteRausArray)

        Counter = 0

  strKennung1 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 18, 1)="_" AND _
Mid(DoppelteRausArray(i), 23, 1)="_"

'msgbox strKennung2 & "   " & DoppelteRausArray(i)
if strKennung1 = True Then
Counter = 0
'Msgbox "iO1" & "   "& DoppelteRausArray(i)
Else
Counter = 11
'Msgbox "niO1" & "   "& DoppelteRausArray(i)
end if

if Counter = 11 Then
strKennung2 = Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 17, 1)="_" AND _
Mid(DoppelteRausArray(i), 22, 1)="_"

'msgbox strKennung2 & "   " & DoppelteRausArray(i)
if strKennung2 = True Then
Counter = 0
'Msgbox "iO2" & "   "& DoppelteRausArray(i)

UterSuch3 = split(DoppelteRausArray(i),"_")
'UnterSuchAnz2 = Len(UterSuch3(2))
UnterSuchAnz3 = Len(UterSuch3(3))
'MsgBox "Anz"& UnterSuchAnz2 & " " & UterSuch3(2) & vbCr& _
' "Anz" & UnterSuchAnz3 & " " & UterSuch3(3)
if UnterSuchAnz3 = "3" Then
Counter = 22
end if
Else
Counter = 22
'Msgbox "niO2" & "   "& DoppelteRausArray(i)
end if
end if

if Counter = 22 Then
strKennung3= Mid(DoppelteRausArray(i), 9, 1)="-" AND _
Mid(DoppelteRausArray(i), 11, 1)="-" AND _
Mid(DoppelteRausArray(i), 14, 1)="_" AND _
Mid(DoppelteRausArray(i), 17, 1)="_" AND _
Mid(DoppelteRausArray(i), 22, 1)="_" AND _
Mid(DoppelteRausArray(i), 26, 1)="_"

'msgbox strKennung3 & " 3  " & DoppelteRausArray(i)
if strKennung3 = True Then
Counter = 0
'Msgbox "iO3" & "   "& DoppelteRausArray(i)
Else
Counter = 33
'Msgbox "niO3" & "   "& DoppelteRausArray(i)
end if
end if

If Counter <> 0 Then
n = n  + 1
'msgbox n
ReDim Preserve FehlerArray(n)
FehlerArray(n) = DoppelteRausArray(i)
oFile.WriteLine "  ***  " & DoppelteRausArray(i)
End If
    Next
FehlerAuflistenArray(FehlerArray)

End Sub

Sub FehlerAuflistenArray(FehlerArray)
For i = LBound(FehlerArray) to UBound(FehlerArray)
msgbox FehlerArray(i)
next

end sub

---

------------------
Sei Schlau bleib Dumm !!?!!

[Diese Nachricht wurde von K.Siebert am 30. Aug. 2015 editiert.]

[Diese Nachricht wurde von K.Siebert am 30. Aug. 2015 editiert.]

[Diese Nachricht wurde von K.Siebert am 30. Aug. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

ich meine mit der ersten Array das:

Code:

---

Dim DoppelteRausArray(5)

DoppelteRausArray(0) = "00000000-0-AA_BBB_CCCC_0"
DoppelteRausArray(1) = "00000000-0-AA_BB_CCCC_1"
DoppelteRausArray(2) = "00000000-0-AA_BB_CCCC_DDD_2"

DoppelteRausArray(3) = "0000000-0-AA_BB_CCCCC_3"
DoppelteRausArray(4) = "00000000-0-A_BBB_CCCCC_4"
DoppelteRausArray(5) = "00000000-0-AA_BB_CCCCC_DD_5"

---

Und als Ausgabe werden nicht die PartNumbers Ausgegeben sondern
die Werte aus der "ersten Array"

Code:

---

  ***  0000000-0-AA_BB_CCCCC_3
  ***  00000000-0-A_BBB_CCCCC_4
  ***  00000000-0-AA_BB_CCCCC_DD_5

---

Ich schau es mir aber die Tage mal in Ruhe an.
Vielen Dank aber nochmal für alles 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi also so werden bei mir alle Elemente nur einmal ausgegeben, aber
auch viele die keinen Benennungsfehler haben, da nach den Checks
diese Zeile kommt: If Check01 = False OR Check02 = False Then

Code:

---

'----------------------------------------
Sub ArrayCheckAndToTXT(ByVal oDoc As Document)
'Elemente untersuchen und die mit Fehlern in .txt-Datei schreiben
Counter = 0
For i = LBound(DoubleDell) to UBound(DoubleDell)
Error = 0

Check01 = Mid(DoubleDell(i), 9, 1)="-" AND _
Mid(DoubleDell(i), 11, 1)="-" AND _
Mid(DoubleDell(i), 14, 1)="_" AND _
Mid(DoubleDell(i), 17, 1)="_" AND _
Mid(DoubleDell(i), 22, 1)="_"

Check02 = Mid(DoubleDell(i), 9, 1)="-" AND _
Mid(DoubleDell(i), 11, 1)="-" AND _
Mid(DoubleDell(i), 14, 4)="____" AND _
Mid(DoubleDell(i), 17, 1)="_" AND _
Mid(DoubleDell(i), 22, 1)="_"

If Check01 = True OR Check02 = True Then
DoubleDell(i) = DoubleDell(i-1)
End If
If Check01 = False OR Check02 = False Then
Error = 1
Counter = Counter + 1
End If
Next

If Error <> 0 Then
strPath = oDoc.Path
sFileName = strPath & "\ErrorLog" & ".txt"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile(sFileName, True)

'Schriftkopf erstellen
oDocName = oDoc.Product.PartNumber
oFile.WriteBlankLines 1
oFile.WriteLine "==============================================================ErrorLog======================================================================="
oFile.WriteLine "    Projekt:  " & oDocName
oFile.WriteLine "      Datum:  " & CStr(Date)
oFile.WriteLine "    Uhrzeit:  " & CStr(Time)
oFile.WriteLine "  Ersteller:  " & CATIA.SystemService.Environ("USERNAME")
oFile.WriteLine "============================================================================================================================================="
'...
oFile.WriteBlankLines 2
oFile.WriteLine "============================================================================================================================================="
oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                                                  = "
oFile.WriteLine "============================================================================================================================================="
oFile.WriteBlankLines 1
End If

For i = LBound(DoubleDell) to UBound(DoubleDell)
oFile.WriteLine "  ***  " & DoubleDell(i)
Next

If Error <> 0 Then
Box = MsgBox("Es befinden sich " & Counter & " Bennungsfehler in der Konstruktion." & vbLF & _
"Korrigieren Sie die Benennungen nach den OEM-Richtlinien."  & vbLF & _
"----------------------------------------------------------------"  & vbLF & _
"Das ErrorLog befindet sich im Projektverzeichnis.", 48, "Warning")
Else
Box = MsgBox("Die Benennungen in der Konstruktion enthalten keine Fehler.", 64, "Note")
End If

End Sub
'----------------------------------------

---

Da aber fast immer ein Check = False ist muss es eigentlich AND
heißen. Dann hängt sich das Makro aber entweder bei LBound oder bei
oFile auf. Ich sehe aber keinen Zusammenhang warum es mit OR geht
und mit AND nicht?!

Code:

---

For i = LBound(DoubleDell) to UBound(DoubleDell)
oFile.WriteLine "  ***  " & DoubleDell(i)

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Was mach die Zeile?

Code:

---

DoubleDell(i) = DoubleDell(i-1)

---

Ich würde ggf einfach wenn die Checks erfolgreich sind die in das entsprechende Element zb "-" schreiben.
Bei schreiben der Zeile kannst du dann der String auswerten und wenn nicht "-" da steht den String ausgeben.

Arbeitest du in VBA? Was "sagt" das Watchfenster zu den Objekten?
Schonmal das Makro schrittweise ausgeführt?
Die Zeile "oFile.WriteLine "  ***  " & DoubleDell(i)" wird auch ausgeführt wenn keine Fehler auftritt und somit die Datei gar nicht angelegt wird.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Oh mann...
wenn man das falsche Script postet...
So sieht es aktuell aus  

Ich arbeite mit CatScript.

Code:

---

'----------------------------------------
Sub ArrayCheckAndToTXT(ByVal oDoc As Document)
'Elemente untersuchen und die mit Fehlern in .txt-Datei schreiben
Counter = 0
n = n-1

For i = LBound(DoubleDell) to UBound(DoubleDell)
Error = 0

Check01 = Mid(DoubleDell(i), 9, 1)="-" AND _
Mid(DoubleDell(i), 11, 1)="-" AND _
Mid(DoubleDell(i), 14, 1)="_" AND _
Mid(DoubleDell(i), 17, 1)="_" AND _
Mid(DoubleDell(i), 22, 1)="_"

Check02 = Mid(DoubleDell(i), 9, 1)="-" AND _
Mid(DoubleDell(i), 11, 1)="-" AND _
Mid(DoubleDell(i), 14, 4)="____" AND _
Mid(DoubleDell(i), 17, 1)="_" AND _
Mid(DoubleDell(i), 22, 1)="_"

If Check01 = False OR Check02 = False Then
Error = 1
Counter = Counter + 1

n = n  + 1
ReDim Preserve ErrArray(n)
ErrArray(n) = DoubleDell(i)
End If
Next

If Error <> 0 Then
strPath = oDoc.Path
sFileName = strPath & "\ErrorLog" & ".txt"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile(sFileName, True)

'Schriftkopf erstellen
oDocName = oDoc.Product.PartNumber
oFile.WriteBlankLines 1
oFile.WriteLine "==============================================================ErrorLog======================================================================="
oFile.WriteLine "    Projekt:   " & oDocName
oFile.WriteLine "      Datum:   " & CStr(Date)
oFile.WriteLine "    Uhrzeit:   " & CStr(Time)
oFile.WriteLine "  Ersteller:   " & CATIA.SystemService.Environ("USERNAME")
oFile.WriteLine "============================================================================================================================================="
'...
oFile.WriteBlankLines 2
oFile.WriteLine "============================================================================================================================================="
oFile.WriteLine "= Folgende Fehler sind in der Struktur enthalten:                                                   = "
oFile.WriteLine "============================================================================================================================================="
oFile.WriteBlankLines 1
End If

For i = LBound(ErrArray) to UBound(ErrArray)
oFile.WriteLine "  ***  " & ErrArray(i)
Next

If Error <> 0 Then
Box = MsgBox("Es befinden sich " & Counter & " Bennungsfehler in der Konstruktion." & vbLF & _
"Korrigieren Sie die Benennungen nach den OEM-Richtlinien."  & vbLF & _
"----------------------------------------------------------------"  & vbLF & _
"Das ErrorLog befindet sich im Projektverzeichnis.", 48, "Warning")
Else
Box = MsgBox("Die Benennungen in der Konstruktion enthalten keine Fehler.", 64, "Note")
End If

End Sub
'----------------------------------------

---

[Diese Nachricht wurde von shoutz000 am 03. Sep. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

kleiner Verbesserungsvorschlag. Statt:

Code:

---

'----------------------------------------
Sub ArrayCheckAndToTXT(ByVal oDoc As Document)
  'Elemente untersuchen und die mit Fehlern in .txt-Datei schreiben
  Counter = 0
  n = n-1

  For i = LBound(DoubleDell) to UBound(DoubleDell)
      Error = 0

      Check01 = Mid(DoubleDell(i), 9, 1)="-" AND _
      Mid(DoubleDell(i), 11, 1)="-" AND _
      Mid(DoubleDell(i), 14, 1)="_" AND _
      Mid(DoubleDell(i), 17, 1)="_" AND _
      Mid(DoubleDell(i), 22, 1)="_"

      Check02 = Mid(DoubleDell(i), 9, 1)="-" AND _
      Mid(DoubleDell(i), 11, 1)="-" AND _
      Mid(DoubleDell(i), 14, 4)="____" AND _
      Mid(DoubleDell(i), 17, 1)="_" AND _
      Mid(DoubleDell(i), 22, 1)="_"

      If Check01 = False OR Check02 = False Then
        Error = 1
        Counter = Counter + 1

        n = n  + 1
        ReDim Preserve ErrArray(n)
        ErrArray(n) = DoubleDell(i)
      End If
  Next

---

durch Umstellung des Zählers

Code:

---

'----------------------------------------
Sub ArrayCheckAndToTXT(ByVal oDoc As Document)
'Elemente untersuchen und die mit Fehlern in .txt-Datei schreiben
  'Counter = 0
  n = 0

  For i = LBound(DoubleDell) to UBound(DoubleDell)
      Error = 0

      Check01 = Mid(DoubleDell(i), 9, 1)="-" AND _
      Mid(DoubleDell(i), 11, 1)="-" AND _
      Mid(DoubleDell(i), 14, 1)="_" AND _
      Mid(DoubleDell(i), 17, 1)="_" AND _
      Mid(DoubleDell(i), 22, 1)="_"

      Check02 = Mid(DoubleDell(i), 9, 1)="-" AND _
      Mid(DoubleDell(i), 11, 1)="-" AND _
      Mid(DoubleDell(i), 14, 4)="____" AND _
      Mid(DoubleDell(i), 17, 1)="_" AND _
      Mid(DoubleDell(i), 22, 1)="_"

      If Check01 = False OR Check02 = False Then
        Error = 1
        'Counter = Counter + 1

        ReDim Preserve ErrArray(n)
        ErrArray(n) = DoubleDell(i)
        n = n  + 1
      End If
  Next

---

Nachdem 'Counter' im weiteren Verlauf nicht benützt wird, kann's entfallen. Ausserdem gilt: n = Counter
Falls 'n' nicht als globale Variable definiert ist, kann die Initialisierung 'n = 0' auch entfallen.

Tschau,
Joe

------------------
Inoffizielle Catia Hilfeseite

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus
Weiterer Hinweise:
- bei jedem Schleifendurchlauf setzt du mit "Error = 0" den Fehler zurück. Somit kannst du dies nicht nutzen um das Anlegen der log-Datei anzustossen
- das "End If" beim anlegen/Schreiben der log-Datei, muss bis nach der Schleife über den Array verschoben werden (sonst gibt es ggf die Datei ja nicht

Gruß
Bernd

PS: Bitte den Code einrücken, dann sieht man schneller wo Schleifen, Bedingungen, Verzweigen anfangen/enden

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

12347.txt

Funzt wunderbar.

Vielen Dank nochmal

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP