---

Stuckliste.png

Hallo zusammen,

ich habe das Forum durchforstet, allerdings nichts passendes gefunden. Ich habe zwei Probleme bei denen ich ums verrecken nicht weiter komme. In Punkto Makros bin ich Neuling. Ich habe eine Baugruppe in der Parts und Products enthalten sind. Die Products ohne wichtige Parameter und die Parts mit den gewollten und erstellen Parametern. Das Makro soll mir nun in bestimmte Spalten und Zeilen diese Paramter schreiben um so eine Stückliste zu erstellen. Ich habe folgendes geschrieben:

Sub CATMain()

' Exel öffnen
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set oAWBook = objxl.Workbooks.Add

    objXL.Cells(2,1).Value = ("Pos_Nr.")
    objXL.Cells(2,2).Value = ("Menge")
    objXL.Cells(2,3).Value = ("Bezeichnung")
    objXL.Cells(2,4).Value = ("Material")
    objXL.Cells(2,5).Value = ("Masse")
    objXL.Cells(2,6).Value = ("Durchmesser")
    objXL.Cells(2,7).Value = ("Länge")
    objXL.Cells(2,8).Value = ("Breite")
    objXL.Cells(2,9).Value = ("Höhe")
    objXL.Cells(2,10).Value = ("DIN EN ISO")
    objXL.Cells(2,11).Value = ("Produktart")

i = 0
for i = 1 to CATIA.Documents.Count
  If (Right(CATIA.Documents.Item(i).Name,7) = "CATPart" ) then
  Set prod = CATIA.Documents.Item(i).Product

    objXL.Cells(2+i,1).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString

    objXL.Cells(2+i,3).Value = prod.PartNumber
    objXL.Cells(2+i,4).Value = prod.Parameters.Item("Material").ValueAsString
    objXL.Cells(2+i,5).Value = prod.Parameters.Item("Masse").ValueAsString
    objXL.Cells(2+i,6).Value = prod.Parameters.Item("Durchmesser").ValueAsString
    objXL.Cells(2+i,7).Value = prod.Parameters.Item("Laenge").ValueAsString
    objXL.Cells(2+i,8).Value = prod.Parameters.Item("Breite").ValueAsString
    objXL.Cells(2+i,9).Value = prod.Parameters.Item("Hoehe").ValueAsString
    objXL.Cells(2+i,10).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString
    objXL.Cells(2+i,11).Value = prod.Parameters.Item("Produktart").ValueAsString

  end if

next

End Sub

>>> Dieses Makro tut auch wunderbar sowohl bei kleinen als auch bei großen Baugruppen. Problem an der Sache ist allerdings

1. das er mir die Bauteile nicht zählt (siehe Anhang >schwarz hat das Makro geschrieben rot>leere Zeilen)

2. Listet mir das Makro zwar alle Parts auf, allerdings wird so nicht ersichtilich in welcher Baugruppe dieses Part vorkommt... Also in der Stückliste soll das dann wie folgt aussehen:

Stückliste für Hauptbaugruppe:

-Unterbaugruppe1
  -4x Part1
  -4x Part2
-Unterbaugruppe2
  -2x Part1
  -2x Part2
-Part1
-Part2
-Part3
-Part4
-Part5
.
.
.

...und aktuell wird mir Part1 und Part2 nur einmal angezeigt und es ist aus der Stückliste nicht ersichtlich das die zwei Parts in der Hauptbaugruppe und den unterbaugruppen ist. Also nur so:

Part1
Part2
Part3
.
.
.

Ich hoffe das mir jemand helfen kann.

Grüße und schonmal Danke im Vorraus

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

---

Servus
Ich würde dazu die CATIA interne Funktion zum erstellen der Stückliste verwenden. (Analyse -> Stückliste)
Wenn du eine passende Einstellung gefunden hast kannst du per Makrorekorder diese auch aufzeichnen (siehe auch vergleichbares Makro hier)

Gruß
Bernd

PS: Bitte Systeminfo ausfüllen.

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

[Diese Nachricht wurde von bgrittmann am 19. Aug. 2013 editiert.]

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

---

Hallo Bernd,

hmm ich habe die Systeminfo ausgefüllt... müsste eigentlich angezeigt werden. CatiaV5 R19 und Windows 7 Professional.

Ja ok BoM listet alles schön auf das stimmt schon, kann aber meine Paramter nicht auslesen. BoM liest ja nur die Informationen, welche unter Properties defeniert wurden. Ich habe Beiträge gefunden in denen es heißt, dass man angeblich die infos in Proberties mit Parametern verlinken kann. Unter Properties kann man ja weiter hinzufügen wie zb. Masse. Dann rechtsklick in das leere Feld und dann AddFormular. Das geht allerdings bei mir nicht. Auch durchs schließen und wieder neuaufmachen was angeblich auch funktionieren soll... dh. kommt in der Systeminternen BoM nur Material und Partname und anzahl.

Alles andere wie Rohteilmaße Masse usw kann nicht ausgelesen werden...

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

---

Servus
Falls du die Parameter nicht in die UserProperties mit aufnehmen kannst wird es komplexer (ggf auch bei jemandem Programmieren lassen):
- Statt über die Documents-Collection die Products-Collection abarbeiten
- jedes Product prüfen, ob dies schon in der Stückliste vorhanden ist, wenn ja Menge erhöhen
- Makro rekursiv aufbauen, um Unterbaugruppen aufzulösen

Gruß
Bernd

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

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

---

Dann muss ich wohl jemanden finden...
hab mir das bisschen nur über das Forum hier angeeignet, da ich für das eine Makro kein Fachbuch kaufen will und dh versteh ich grade ziemlich viel Bahnhof... xD

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

---

Servus
ggf hat auch schon ein Dienstleister/Systemhaus ein fertiges Tool. Ist ggf günstiger als sich selbst in Thematik einzuarbeiten (bis solch ein Makro läuft können ohne Erfahrung sehr schnell 3-5 Tage ins Land gehen)

Gruß
Bernd

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

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

---

Hallo,

Wenn du alle PartNumber in die Excel Tabelle hast, kannst du sie durchlesen un für jeden PartNumber die verschiede Parameter lesen, hier ein beispiel (in CatVba):

Code:

---

For l = 7 To nbLigne
    Set maCellule = maFeuilleExcel.Range("C" & l) '-->  Wo sich die Partnumber finden
    Dim MaMat
    Dim MonPartNumber As String
    MonPartNumber = maCellule.Value
    Dim PartCherchee
    On Error Resume Next
        Set PartCherchee = monDocCATIA.GetItem(MonPartNumber)
        Set MaMat = PartCherchee.parameters.Item("Matériau") '--> biespiel für material
        If Err.Number <> 0 Then
            maFeuilleExcel.Range("H" & l).Value = "Non défini dans 3D"
            maFeuilleExcel.Range("H" & l).Interior.ColorIndex = 6
        Else
            maFeuilleExcel.Range("H" & l).Value = MaMat.Value
        End If
  On Error GoTo 0
Next l

---

Offe das kann dir helfen
Gruss
Marc

------------------
Gruss
Marc

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

---

Hi,

Verstehe ich das richtig, dass der code jetzt die Parameter aus den Parts ausließt?! Weil das macht mein Makro ja bereits...

...ich bekomme es bloß nicht hin das er die selben Parts zählt. Also zb 4x Part1 2x Part2... usw.

Oder was kann das script genau was Du mir da geschrieben hast?

Trotzdem schonmal vielen Dank :-)

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

---

Servus
Hier findest du ein kleines Beispiel zu Rekursion und Stückzahl von Teilen zu bestimmen.
Viel Spaß damit.

Gruß
Bernd

EDIT: Hier gibt es auch noch eine Vorlagen/Code-Schnippel

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

[Diese Nachricht wurde von bgrittmann am 21. Aug. 2013 editiert.]

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

---

Hallo "shoutz000",

Wie es Bernd gesagt hat, musst du zuerst die BOM Funktion benutzen um die Stückliste in eine Excel Datei zu haben mit den gewünschten Format:

-Unterbaugruppe1
  -4x Part1
  -4x Part2
-Unterbaugruppe2
  -2x Part1
  -2x Part2
-Part1
-Part2
-Part3
-Part4
-Part5

Dann durch den script jeden CATPart aktivieren und seine Parameter in den Excel Tabelle hinzufügen.

------------------
Gruss
Marc

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

---

moin moin,

ich würde sowas in der art vorschlagen.

Code:

---

dim oStream As TextStream

Sub CATMain()
CATInit
CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE
TreeWalk CATIA.ActiveDocument.Product

End Sub

Sub CATInit()
dim oFile as File
Set oFile = CATIA.FileSystem.CreateFile("C:\bom.txt", true)
set oStream = oFile.OpenAsTextStream("ForWriting")

End Sub

Sub TreeWalk(oProd As Product)
dim strPartNumber as string
dim oChild as Product
dim oDict1 As Object
dim oDict2 as Object
Set oDict1 = CreateObject("Scripting.Dictionary")
Set oDict2 = CreateObject("Scripting.Dictionary")

'write product to file
oStream.Write (oProd.PartNumber & Chr(10))

'loop gets quantity
for each oChild in oProd.Products
if oChild.Products.Count > 0 then
'product has children
TreeWalk oChild
else
strPartNumber = oChild.PartNumber
if oDict1.Exists(strPartNumber) then
oDict1.Item(strPartNumber) = oDict1.Item(strPartNumber) +1
else
oDict1.Add(strPartNumber), 1
end if
end if
next

'loops prints values
for each oChild in oProd.Products
if oChild.Products.Count < 0 then
'product has children
TreeWalk oChild
else
strPartNumber = oChild.PartNumber
if oDict2.Exists(strPartNumber) then
'already printed to file
else
printToFile oChild, oDict1.Item(oChild.PartNumber)
oDict2.Add(strPartNumber), true
end if
end if
next

End Sub

Sub printToFile (oChild As Product, strQuantity As string)
oStream.Write(oChild.PartNumber & ";quantity: " & strQuantity & chr(10))
End Sub

---

Zur Zeit schreibt es die Werte in einer txt Datei. Den Pfad muss du wohl ändern.
Es läuft nur unter Windows aufgrund des das Dictionary Objects.
Ich habe es als CATScript geschrieben.
Mit dem Sub printToFile kannst du die Ausgabe (nach Excel) gestalten. KOnnte hier nichts machen/testen, denn ich habe keinen Excel.

Hoffe es hilft dir weiter.
Gruß

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

---

Ok vielen Dank an euch alle.
Ich kann leider zur Zeit kein Feedback geben da bei mir im Geschäft seid letzter Woche Mittwoch der Server ständig abkackt und net funzt. Heute hieß es er tut wieder... ok die Laufwerke werden alle angezeigt aber Catia geht nicht auf und fast alle Projektdaten fehlen. Ich werde mal alles ausprobieren wenn wieder alles läuft und melde mich dann zurück.

Gruß Frank

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

---

So läuft wieder alles im Geschäft.

Also das mit der Recursiven suche ist ja schön und gut aber wie gesagt ich kenn mich damit null aus. Kann HTML von früher noch ja, ich versteh auch einzelne Passagen oder kann erahnen wofür sie gut sind. Aber ich bin schon stolz das ich überhaupt das obige Makro hingebastelt bekommen habe. Dh. erst BOM aufrufen und dann die restlichen Parameter einlesen lassen klingt gut... aber wie?!?!  Momentan bastel ich Schnipselchen zusammen und freu mich jedesmal wenn eine Zeile durchlaufen wurde ohne Fehlermeldung. Ausspucken tut er trotzdem nichts wertvolles. Ich habe mit sowas eigentlich nix am Hut bloß dieses eine Makro brauch ich und deshalb tu ich mir das an aber... naja... Nervenbelastung 100% Erfolg... unterirdisch!

Also MarcL68 danke für dein Script, ich habe es versucht irgendwie einzubauen aber klappt gar nicht. Vielleicht verträgt sich das Französisch nich mit meinem Catia xD

DasDon dein Script funzt im Gegensatz zu meinen xD. Hab auch versucht es in Excel schreiben zu lassen. Also er erstellt eine Exceltabelle aber die ist defekt... muss wohl noch irgendeine Zeile ändern.
Nun muss ich es nur noch irgendwie hinbekommen das er die zugehörigen Parameter ausliest und ausspuckt.
Achso und die Unterprodukte gibt er zwar an und auch wie viele Parts drin sind, aber er zählt die Unterprodukte selber nicht?! Aber stand ja so auch nicht in meiner Frage, währe aber toll wenn es das auch noch zählen würde 

Vielen Dank trotzdem.
Freu mich und hoffe auf weitere Infos :-P

Grüße
Frank

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

---

moin mloin,

wie dringend brauchst du es? Ich bin zur Zeit mit etwas anderes stark beschäftigt, aber nach nächste Woche sollte es sich etwas reduziert haben. Dann könnte ich vielleicht es so umschreiben wie du es brauchst.

Gruß,

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

---

Kein Problem machs ja schon lang mit der Hand am Arm da kommts auf die paar Tage absolut nicht drauf an xD.

Ex spitze freut mich echt   
Grüße
Frank

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

---

könnte etwas langsam sein...
und ich weiß nicht ob es Funktioniert, kenne deine Bauteile nicht und möchte ungen mir einen CATProduct aufbauen der PArts mit den den ganzen parameters enthällt...

ist nicht idioten sicher aber dafür hast du es.. falls es nicht so funktioniert wie du willst, sage bescheid.

gruß,
Dean

[Diese Nachricht wurde von DasDon am 13. Sep. 2013 editiert.]

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

---

Hey super also funktionieren tut es auch recht schnell,
habs mir kurz angeschaut und habs durchlaufen lassen, weil ich bin grad auch leider voll eingespannt.
2 Probleme gibt es noch.

1: Wenn ein UnterProduct mehrmals vorhanden ist listet er es auch so oft auf

z.B Product 1
      4* Part 1

    Product 1
      4* Part 1

Soll aber eig so sein:
    2* Product 1
      4* Part 1

geht das irgendwie?!

2: Fast immer macht er zwischen zwei Funden 3 leere Zeilen rein (daher wird es eine
unheimlich lange Tabelle da nur 1/3 der Zeilen gefüllt sind) manchmal sind aber auch
wieder zwei Funde direkt untereinander und dann erst wieder drei Zeilen leer...

Ich habe ein bisschen rumprobiert aber nix gefunden... und mit dem Zeilenbefehl (X+i,X)
hat er doch eigentlich den Befehl "ein weiterer Fund geh eine Zeile weiter runter" oder?!

Aber vorert auf jeden Fall vielen vielen Dank ist echt super :-)

Grüße
Frank

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

---

Oh ich habe gestern wohl nicht richtig geschaut...

...das Makro gibt für jedes Product und Part als Menge immer
nur "1" an :-(

Es listet die Products wiegesagt so oft auf wie sie drin sind und dann immer mit der Mengenangabe "1" Die Parts listet es aber nur einmal auf und auch nur mit der Mengenangabe "1"?!

Gruß
Frank

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

---

Hallo shoutz000,

habe es mir nicht großartig angeschaut, aber Du hast ja bereits ein Dictionary im EInsatz. Dort merkte ich mir dann immer einfach dei Quantity. Du prüfst ja ehh ob's schon da ist, dann kannste den Zähler auch um 1 erhöhen jedes Mal.

------------------
Mit freundlichen Grüßen,
Henry Schneider
alias Lila

Es gibt einen ewigen Wettkampf zwischen der Natur und den Ingenieuren:
Die Ingenieure versuchen, immer idioten-sicherere Systeme zu bauen,
die Natur versucht, immer bessere Idioten zu bauen

Xing

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

---

moin moin,

Entschuldige die schlechte Qualität. Habe wohl nicht wirklich aufgepasst und mich somit blammiert.  

Jetzt habe ich es wenigstens auf einen echten, etwas größeren Baugruppe getestet. Und es ist zumindest bei mir fehler Frei.
(der Zähler war nicht richtig Positioniert und es wurde nicht "zurück" gezählt bei mehrfachverbauten Bauteile, deswegen die löcher)

Ich konnte aber auf die schnelle nicht den CATProduct zähler einbinden. Irgendwie stehe ich dort auf dem schlauch. Habe zwar die Anzahl hinbekommen aber nicht die 1mal-auflisten-funktion.

Da die übersicht bei verschachtelten Baugruppen schlecht war, habe ich die Einbauebene mit eingefügt.

Sorry noch mal, hoffe das läuft jetzt besser.
Gruß

neuer code unten

[Diese Nachricht wurde von DasDon am 11. Okt. 2013 editiert.]

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

---

Ist doch absolut kein Problem ;-)

Super klappt einwandferi. Ich versuch dann mal es vielleicht noch hinzubekommen das die doppelten
Baugruppen nicht mehrmals angezeigt und gezählt werden. Vielen Dank auf jeden Fall.
Falls Du noch eine Idee hast wie man das bewerkstelligen kann währe das natürlich auch klasse xD.

Hey Du warst mir echt ne spitzen Hilfe / Lösung xD

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

---

Und für die Unterbaugruppe muss es auch noch ein paar Parameter auslesen :-/
Weil das sind ja dann oft SWT's. POS-Nr Herstelle und Norm ist da als Parameter
hinterlegt...

Schade das Du in Hamburg wohnst ansonsten hätte ich dich auf nen paar Bier eingeladen
xD

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

---

StucklisteschnippselausCad.de.zip

ich hatte mir mal schnippsel aus http://ww3.cad.de/foren/ubb/Forum137/HTML/005104.shtml#000004 genommen um mir das zu bauen

verschiedene Versuche eine Stückliste zu machen^^ Vers 3 ist die am weitesten fortgeschrittenste -aber sie gefällt mit noch nicht ,)

Code:

---

If oProd.DescriptionRef >= "" Then '<> "" wenn leere ausgelassen werden sollen, = "Betriebsmittel-E_WBK" Then

---

Wenn leere Productbeschreibung ausgelassen werden sollen  <> ""
Wenn die Produktbeschreibung ein Kenner enthält, zb. Betriebsmittel-E_WBK, dann = "Betriebsmittel-E_WBK" - es werden dann nur Produkte ausgewertet die den Kenner haben.

[Diese Nachricht wurde von Thomas Harmening am 16. Sep. 2013 editiert.]

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

---

hmmm auch nicht schlecht. Aber auslassen soll es ja nix ;-)

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

---

Es kommt immer darauf an, wie das Product aufgebaut ist;-)

Wenn in einem Unterknoten, Datensätze verwendet werden, die als Referenz gelten (Fzg- Daten z.B.),
dann will ich die ja nicht in meiner Stückliste.
Von daher tragen wir in der Product beschreibung einen Kenner rein, der dann ausgewertet wird ->Stückliste

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

---

Hallo zusammen,

Also der Code von DasDon klappt echt super Problem ist aber weiterhin, dass die unterbaugruppen nicht gezählt werden und für diese
auch keine Parameter ausgelesen werden.... hat jemand eine Idee?     

Code:

dim objXL As Object
dim oAWBook As Object

dim oDict1 As Object

'----------------------------------------
Sub CATMain()

setUpExcel
CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE

TreeWalk CATIA.ActiveDocument.Product, 0 , 0
END_MESSAGE
End Sub
'----------------------------------------

'----------------------------------------
Sub setUpExcel()
' Exel öffnen
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set oAWBook = objxl.Workbooks.Add

    objXL.Cells(1,1).Value = ("Pos_Nr.")
objXL.Cells(1,2).Value = ("EinbaueEbene")
    objXL.Cells(1,3).Value = ("Menge")
    objXL.Cells(1,4).Value = ("Bezeichnung")
    objXL.Cells(1,5).Value = ("Material")
    objXL.Cells(1,6).Value = ("Masse")
    objXL.Cells(1,7).Value = ("Durchmesser")
    objXL.Cells(1,8).Value = ("LÀnge")
    objXL.Cells(1,9).Value = ("Breite")
    objXL.Cells(1,10).Value = ("Höhe")
    objXL.Cells(1,11).Value = ("DIN EN ISO")
    objXL.Cells(1,12).Value = ("Produktart")

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

'----------------------------------------
Sub WriteToExcel(byVal prod As product, byVal i As Integer, byVal quantity As Integer, byVal eibauLvl as Integer)

objXL.Cells(2+i,2).Value = eibauLvl
objXL.Cells(2+i,3).Value = quantity
objXL.Cells(2+i,4).Value = prod.PartNumber

On error resume next
    objXL.Cells(2+i,1).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString

    objXL.Cells(2+i,5).Value = prod.Parameters.Item("Material").ValueAsString
    objXL.Cells(2+i,6).Value = prod.Parameters.Item("Masse").ValueAsString
    objXL.Cells(2+i,7).Value = prod.Parameters.Item("Durchmesser").ValueAsString
    objXL.Cells(2+i,8).Value = prod.Parameters.Item("Laenge").ValueAsString
    objXL.Cells(2+i,9).Value = prod.Parameters.Item("Breite").ValueAsString
    objXL.Cells(2+i,10).Value = prod.Parameters.Item("Hoehe").ValueAsString
    objXL.Cells(2+i,11).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString
    objXL.Cells(2+i,12).Value = prod.Parameters.Item("Produktart").ValueAsString
End Sub
'----------------------------------------

'----------------------------------------
Sub treewalk(byVal oProd As Product, byref lvlCounter As intger, byref eibauLvl as Integer)
dim strPartNumber as string
dim oChild as Product
dim oDict1 as Object
dim oDict2 as Object
Set oDict1 = CreateObject("Scripting.Dictionary") 'keeps item quantity
Set oDict2 = CreateObject("Scripting.Dictionary") 'keeps part item print state

' gets components count
for each oChildCount in oProd.Products
if oDict1.Exists(oChildCount.PartNumber) then
oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1
else
oDict1.Add(oChildCount.PartNumber), 1
End If
Next

objXL.Cells(lvlCounter +2 ,2).value = eibauLvl
objXL.Cells(lvlCounter +2 ,4).value = oProd.PartNumber

for each oChild in oProd.Products
lvlCounter = lvlCounter + 1
if oChild.Products.Count > 0 then
'product has children
printedProduct = True
TreeWalk oChild, lvlCounter , eibauLvl +1
else
strPartNumber = oChild.PartNumber
if oDict2.Exists(strPartNumber) then
lvlCounter = lvlCounter - 1
else
oDict2.Add(strPartNumber), true
WriteToExcel oChild, lvlCounter, oDict1.Item(strPartNumber), eibauLvl +1
end if
end if
next
End Sub

Vielen Dank schonmal im Vorraus :-)

[Diese Nachricht wurde von shoutz000 am 30. Sep. 2013 editiert.]

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

---

Hier nochmals das Macro mit ein paar kleinen Anpassungen.
Weiß denn wirklich keiner eine Möglichkeit um die Unterbaugruppen mit zu zählen und auch deren Parameter aus zu lesen???
...please Help... 

------------------------------------------------------------------
Language="VBSCRIPT"

dim objXL As Object
dim oAWBook As Object
dim oDict1 As Object

'----------------------------------------
Sub CATMain()
setUpExcel
CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE
TreeWalk CATIA.ActiveDocument.Product, 0 , 0
END_MESSAGE
End Sub
'----------------------------------------

'----------------------------------------
Sub setUpExcel()
' Exel Öffnen
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set oAWBook = objxl.Workbooks.Add

'Spaltentitel
objXL.Cells(1,1).Value = ("EinbaueEbene")
    objXL.Cells(1,2).Value = ("Pos_Nr.")
    objXL.Cells(1,3).Value = ("Menge")
    objXL.Cells(1,4).Value = ("Bezeichnung")
    objXL.Cells(1,5).Value = ("Material")
    objXL.Cells(1,6).Value = ("Masse")
    objXL.Cells(1,7).Value = ("Durchmesser")
    objXL.Cells(1,8).Value = ("Länge")
    objXL.Cells(1,9).Value = ("Breite")
    objXL.Cells(1,10).Value = ("Höhe")
    objXL.Cells(1,11).Value = ("DIN EN ISO")
    objXL.Cells(1,12).Value = ("Produktart")

'Spaltentitel_Bold
    objXL.Cells(1,1).Font.Bold = True
    objXL.Cells(1,2).Font.Bold = True
    objXL.Cells(1,3).Font.Bold = True
    objXL.Cells(1,4).Font.Bold = True
    objXL.Cells(1,5).Font.Bold = True
    objXL.Cells(1,6).Font.Bold = True
    objXL.Cells(1,7).Font.Bold = True
    objXL.Cells(1,8).Font.Bold = True
    objXL.Cells(1,9).Font.Bold = True
    objXL.Cells(1,10).Font.Bold = True
    objXL.Cells(1,11).Font.Bold = True
    objXL.Cells(1,12).Font.Bold = True

'Spaltenbreite
    objXL.Range("A1").ColumnWidth = 14
    objXL.Range("B1").ColumnWidth = 10
    objXL.Range("C1").ColumnWidth = 10
    objXL.Range("D1").ColumnWidth = 38
    objXL.Range("E1").ColumnWidth = 14
    objXL.Range("F1").ColumnWidth = 11
    objXL.Range("G1").ColumnWidth = 14
    objXL.Range("H1").ColumnWidth = 14
    objXL.Range("I1").ColumnWidth = 14
    objXL.Range("J1").ColumnWidth = 14
    objXL.Range("K1").ColumnWidth = 25
    objXL.Range("L1").ColumnWidth = 10
  End Sub
'----------------------------------------

'----------------------------------------
Sub WriteToExcel(byVal prod As product, byVal i As Integer, byVal quantity As Integer, byVal eibauLvl as Integer)
objXL.Cells(3+i,1).Value = eibauLvl
objXL.Cells(3+i,3).Value = quantity
objXL.Cells(3+i,4).Value = prod.PartNumber
On error resume next
    objXL.Cells(3+i,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString
    objXL.Cells(3+i,5).Value = prod.Parameters.Item("Material").ValueAsString
    objXL.Cells(3+i,6).Value = prod.Parameters.Item("Masse").ValueAsString
    objXL.Cells(3+i,7).Value = prod.Parameters.Item("Durchmesser").ValueAsString
    objXL.Cells(3+i,8).Value = prod.Parameters.Item("Laenge").ValueAsString
    objXL.Cells(3+i,9).Value = prod.Parameters.Item("Breite").ValueAsString
    objXL.Cells(3+i,10).Value = prod.Parameters.Item("Hoehe").ValueAsString
    objXL.Cells(3+i,11).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString
    objXL.Cells(3+i,12).Value = prod.Parameters.Item("Produktart").ValueAsString
End Sub
'----------------------------------------

'----------------------------------------
Sub treewalk(byVal oProd As Product, byref lvlCounter As intger, byref eibauLvl as Integer)
dim strPartNumber as string
dim oChild as Product
dim oDict1 as Object
dim oDict2 as Object
Set oDict1 = CreateObject("Scripting.Dictionary") 'keeps item quantity
Set oDict2 = CreateObject("Scripting.Dictionary") 'keeps part item print state

' gets components count
for each oChildCount in oProd.Products
if oDict1.Exists(oChildCount.PartNumber) then
oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1
else
oDict1.Add(oChildCount.PartNumber), 1
End If
Next

objXL.Cells(lvlCounter +3 ,1).value = eibauLvl
objXL.Cells(lvlCounter +3 ,4).value = oProd.PartNumber

for each oChild in oProd.Products
lvlCounter = lvlCounter + 1
if oChild.Products.Count > 0 then
'product has children
printedProduct = True
TreeWalk oChild, lvlCounter , eibauLvl +1
else
strPartNumber = oChild.PartNumber
if oDict2.Exists(strPartNumber) then
lvlCounter = lvlCounter - 1
else
oDict2.Add(strPartNumber), true
WriteToExcel oChild, lvlCounter, oDict1.Item(strPartNumber), eibauLvl +1
end if
end if
next
End Sub

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

---

Ich glaub was Du suchst ist das Zauberwort Rekursion.

Du bleibst ja auf oberster Ebene mit Deiner Verarbeitung.

------------------
Mit freundlichen Grüßen,
Henry Schneider
alias Lila

Es gibt einen ewigen Wettkampf zwischen der Natur und den Ingenieuren:
Die Ingenieure versuchen, immer idioten-sicherere Systeme zu bauen,
die Natur versucht, immer bessere Idioten zu bauen

Xing

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

---

Moin moin,

Einmal ausprobieren, bitte.

Gruß,
Dean

PS: Ich würde dir empfehlen die Fertigmeldungsnachricht im Macro zubehalten. Du muss nicht das behalten was ich benutzte, aber etwas anderes würde auch Sinn machen.

PPS: Auch würde ich es nett finden, wenn du meinen Namen als Ersteller/Mitwirkender/oder Ähnliches im Quellcode behalten würdest. Zumindest wenn du es hier wieder Postest.

neuer code unten

[Diese Nachricht wurde von DasDon am 11. Okt. 2013 editiert.]

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

---

oh ok sry. ja bei mir ist das schon alles noch drin, ich wollt bloß den beitrag nicht gaaanz so lang bekommen,
deshalb habe ich nur den eigentlichen haubtteil gepostet xD

ich werde es versuchen heute noch auszuprobieren. spätestens nächste woche. is grad viel los :-)

[Diese Nachricht wurde von shoutz000 am 10. Okt. 2013 editiert.]

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

---

Hammer wunderbar funktioniert einwandfrei...

xD Danke war echt cool von dir :-)
Vielen Dank ich experimentier die nächsten Tage mal dran rum
und versuch die Excel noch bissel bunt zu bekommen :-)

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

---

Super!

dann mach mal Bunt 

gruß,
Dean

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

---

Ach verdammt... die Parameter der Unterbaugruppe werden noch nicht
ausgelesen... :-(

Gruß
Frank

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

---

moin,
welche müssen ausgelesen werden?

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

---

Die Parameter von den Unterbauguppen.
Da sind 3St drin.

Grüße und einen schönen Feierabend 

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

---

Wie sie heißen muss ich wissen, denn die Werte bekomme ich nur wenn ich weiß wo sie zu finden sind 

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

---

Achso alles klar:

1) Produktart
2) DIN EN ISO
3) Pos_Nr.

   
Grüße
Frank

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

---

Danke.

NEW CODE DOWN BELOW

[Diese Nachricht wurde von DasDon am 17. Okt. 2013 editiert.]

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

---

*g* Vielen Dank aber jetzt werden die Parameter des ersten Parts innerhalb der Unterbaugruppe für die Baugruppe angezeigt xD. 

Die eigentlichen Parameter der Unterbaugruppe jedoch nicht. Und die Hauptbaugruppe bekommt ebenfalls die Parameter des ersten Parts in der ersten Unterbaugruppe zugewießen xD.

Grüße und ein schönes Wochenende 
Frank

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

---

Eine Idee woran das liegen kann?

Grüße
Frank
:-)

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

---

Moin,

ja ich weiß warum das so ist. Ich muss nur Zeit haben eine Lösung umzusetzen.
Die Kinderparameter werden im Parameterskollektion mit aufgelistet. Und zwar vor dem des aktuellen Products. CATIA holt sich einfach den erst zutreffenden. Hier die des Kindes.

Gruß,
Dean

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

---

shoutz000_V4.CATSCript.txt

Moin Frank,

so ich hoffe das wars jetzt. Melden wenns nicht hin haut.....

Gruß,
Dean

opps datei vergessen.... 

[Diese Nachricht wurde von DasDon am 17. Okt. 2013 editiert.]

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

---

Hmm merkwürdig...
das Makro dauert sonst knapp 10 sec um alles aus zu lesen.
Diesmal knapp 5 min und ausgelesen wurden nur Material, Einbauebene, Name und Menge...

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

---

Servus
ist bei dem Code klar. Für jeden Parameter müssen über eine Schleife fast alle Parameter der Baugruppe (auch Unterbaugruppe und Einzelteile) durchsucht werden.
ggf schau ich heute Abend mal nach einer schnelleren Lösung.

Gruß
Bernd

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

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

---

Moin moin,

Jo, schnell ist es nicht. (wobei es bestimmt schneller als per Hand ist).

Du muss verstehen, dass die Parameter Kollektion der Parts nur die parameter des Parts beinhalten. Die Kollektion der Baugruppe enthält alle parameter der Baugruppe + die der Kinder!!!

Wenn bei der Hauptbaugruppe nichts rausgeschrieben werden muss, dann würde ich den code so ändern, dass es diese nicht durch sucht. Denn er sucht gleich am anfang alle Parameter ALLE parts/products durch! Das dauert sehr lange.

Vorher hat es einfach aus der "parameter-kiste" parameter1 rausgezogen(Bei Assemblies ist diese vorgehensweise ja leider Falsch).
Da aber in der baugruppe-kiste nfach parameter1 vorhanden sein kann(parameter Namen der parts sind gleich wie die des products. Sprich "Pos_Nr." von part1, "Pos_Nr." von part2, "Pos_Nr." von part3 etc & "Pos_Nr." von Product ) muss es alle durch suchen und den richtigen finden.

Es gibt, besser Wege das Makro zuschreiben. Die brauchen aber länger zu implementieren. Da ich es hier "mal-eben-nebenbei" schreibe und eigentlich andere aufgaben habe (meine Arbeit/Freizeit), habe ich mich für Methode entschieden mit der ich den wenigsten Aufwand habe. Das es evtl. nicht optimal ist, war mir klar.

Gruß,
Dean

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

---

Nein aus der Hauptbaugruppe muss nichts ausgelesen werden.

Das es jetzt länger dauert ist ja nicht so wild weil schneller geht es wie du schon sagtest auf jeden Fall, aber das makro ließt jetzt nur noch ein paar sachen raus (auch bei den Parts).
Die meisten Angaben fehlen das habe ich gemeint ;-)

Aber vorher war das Makro echt flot also ich war begeistert xD

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

---

Servus
Tausch mal folgende Sub aus:

Code:

---

Sub WriteToExcel(ByVal prod As Product, ByVal excelRow As Integer, ByVal quantity As Integer, ByVal instalLvl As Integer)
    Dim i As Integer
    Dim paraFullName As String
    objXL.Cells(3 + excelRow, 1).Value = instalLvl
    objXL.Cells(3 + excelRow, 3).Value = quantity
    objXL.Cells(3 + excelRow, 4).Value = prod.PartNumber
   
    'Fehlerbehandlung abschalten
    On Error Resume Next
    'Parameter auslesen und in Excel eintragen
    objXL.Cells(3 + excelRow, 2).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Pos_Nr.").ValueAsString
    objXL.Cells(3 + excelRow, 5).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Material").ValueAsString
    objXL.Cells(3 + excelRow, 6).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Masse").ValueAsString
    objXL.Cells(3 + excelRow, 7).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Durchmesser").ValueAsString
    objXL.Cells(3 + excelRow, 8).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Laenge").ValueAsString
    objXL.Cells(3 + excelRow, 9).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Breite").ValueAsString
    objXL.Cells(3 + excelRow, 10).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Hoehe").ValueAsString
    objXL.Cells(3 + excelRow, 11).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("DIN EN ISO").ValueAsString
    objXL.Cells(3 + excelRow, 12).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Produktart").ValueAsString

    'Fehlerbehandlung einschalten
    On Error GoTo 0
End Sub

---

Zur Erklärung über RootParameter.DirectParameters erhält man nur die Parameter des jeweiligen Products (nicht der Unterbaugruppen und Einzelteile)

Gruß
Bernd

@shoutz000:
Du bist DasDon zumindest ein Bier schuldig. Andere hätten das programmieren lassen müssen, oder zumindest mehr Eigeniniziative zeigen müssen (also selbst den Code verstehen und verbessern)

EDIT: im Code jeweils ".Item" ergänzt.

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

[Diese Nachricht wurde von bgrittmann am 17. Okt. 2013 editiert.]

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

---

Super, Bernd!  Wie immer!

Ich habe heute abend auch das V5Automation.chm durchblättert nach andere Methoden/Properties in .Parameters und bin über RootParameterSet gestolpert. Der Name nach ist es genau das was wir brauchen. War mir Aufgrund der Beschreibung Returns the root parameter set of a document. If it doesn't exist, it is created. aber nicht sicher.
Dachte das es vieleicht auch nur die Parameter des CATIA.ActiveDocument zurückgibt... über die weiteren Properties von Root... wurde ich auch nicht schlau.

Aber wenn du es sagts wird es stimmen...

Danke für die Hilfe und das neue Wissen.
Gruß,
Dean

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

---

Du das weiß ich selber aber so lern ich auch was dazu und mit der Zeit werd ich es dann auch bestimmt alleine hinbekommen.
Ich bin DasDon voll dankbar was ich ihm auch geschrieben habe :-)
xD punkto Bier schau mal ein paar Beiträge weiter oben 

Ich habe durch das verstehen lernen ja auch ein wenig schon selber gelernt. Ich habe den Code zum Beispiel jetzt so
umgeschrieben das es eine Excelvorlage öffnen und auf die angepasst die Parameter reinschreiben kann oder wie man die
Zellen Spalten und Schriften bearbeiten kann hab ich auch auf die Reihe bekommen... (ist nicht viel aber immerhin...
ich arbeite dran xD)

hmmm hab das jetzt reingeschrieben aber jetzt werden nur Einbauebene Menge und Name ausgegeben... kein einziger Parameter mehr
oder hab ichs falsch eingebaut?

------------------------------------------------------------------------------------------------------------------------------------

MACRO_NAME = "BillOfMaterial"
MACRO_VERS = "V0.4"

'VER: 0.4 FIXED BUG FOR ASSEMBLY PARAMETERS EXTRACTION - CHILD PARTS PARAMETERS ARE PLACED HIGHER IN PARAMETER COLLECTION AND CATIA USES FIRST FOUND VALUE
' 0.3 IMPLEMENTS THE REQUEST TO EXTRACT THE USER PARAMETERS ON THE ASSEMBLIES
' 0.2 IMPLEMENTS THE REQUEST TO COUNT ALSO ASSEMBLIES AND ONLY PRINT THEM ONCE
'DESC: SCANS THE SPEC TREE OF OPENED DOCUMENT AND GENERATES A BOM INCLUDING USER DEFINED PARAMETERS
'PREP: OPEN DOCUMENT MUST BE OF TYPE CATPRODUCT
'LANG: CATSCRIPT
'DATE: 09/09/2013

'CREA: dean.broughall@p3voith.com
'-------------------------------------------

dim objXL As Object
dim oAWBook As Object
dim oDict1 As Object

'----------------------------------------
Sub CATMain()
setUpExcel
CATIA.ActiveDocument.Product.ApplyWorkMode DESIGN_MODE
TreeWalk CATIA.ActiveDocument.Product, 0 , 0, 1
END_MESSAGE
End Sub
'----------------------------------------

'----------------------------------------
Sub setUpExcel()
' Exel Öffnen
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set oAWBook = objxl.Workbooks.Add

'Spaltentitel
objXL.Cells(1,1).Value = ("EinbaueEbene")
objXL.Cells(1,2).Value = ("Pos_Nr.")
objXL.Cells(1,3).Value = ("Menge")
objXL.Cells(1,4).Value = ("Bezeichnung")
objXL.Cells(1,5).Value = ("Material")
objXL.Cells(1,6).Value = ("Masse")
objXL.Cells(1,7).Value = ("Durchmesser")
objXL.Cells(1,8).Value = ("Länge")
objXL.Cells(1,9).Value = ("Breite")
objXL.Cells(1,10).Value = ("Höhe")
objXL.Cells(1,11).Value = ("DIN EN ISO")
objXL.Cells(1,12).Value = ("Produktart")

'Spaltentitel_Bold
objXL.Cells(1,1).Font.Bold = True
objXL.Cells(1,2).Font.Bold = True
objXL.Cells(1,3).Font.Bold = True
objXL.Cells(1,4).Font.Bold = True
objXL.Cells(1,5).Font.Bold = True
objXL.Cells(1,6).Font.Bold = True
objXL.Cells(1,7).Font.Bold = True
objXL.Cells(1,8).Font.Bold = True
objXL.Cells(1,9).Font.Bold = True
objXL.Cells(1,10).Font.Bold = True
objXL.Cells(1,11).Font.Bold = True
objXL.Cells(1,12).Font.Bold = True

'Spaltenbreite
objXL.Range("A1").ColumnWidth = 14
objXL.Range("B1").ColumnWidth = 10
objXL.Range("C1").ColumnWidth = 10
objXL.Range("D1").ColumnWidth = 38
objXL.Range("E1").ColumnWidth = 14
objXL.Range("F1").ColumnWidth = 11
objXL.Range("G1").ColumnWidth = 14
objXL.Range("H1").ColumnWidth = 14
objXL.Range("I1").ColumnWidth = 14
objXL.Range("J1").ColumnWidth = 14
objXL.Range("K1").ColumnWidth = 25
objXL.Range("L1").ColumnWidth = 10
End Sub
'----------------------------------------

'----------------------------------------
Sub WriteToExcel(ByVal prod As Product, ByVal excelRow As Integer, ByVal quantity As Integer, ByVal instalLvl As Integer)
    Dim i As Integer
    Dim paraFullName As String
    objXL.Cells(3 + excelRow, 1).Value = instalLvl
    objXL.Cells(3 + excelRow, 3).Value = quantity
    objXL.Cells(3 + excelRow, 4).Value = prod.PartNumber
 
    'Fehlerbehandlung abschalten
    On Error Resume Next
    'Parameter auslesen und in Excel eintragen
    objXL.Cells(3 + excelRow, 2).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Pos_Nr.").ValueAsString
    objXL.Cells(3 + excelRow, 5).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Material").ValueAsString
    objXL.Cells(3 + excelRow, 6).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Masse").ValueAsString
    objXL.Cells(3 + excelRow, 7).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Durchmesser").ValueAsString
    objXL.Cells(3 + excelRow, 8).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Laenge").ValueAsString
    objXL.Cells(3 + excelRow, 9).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Breite").ValueAsString
    objXL.Cells(3 + excelRow, 10).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Hoehe").ValueAsString
    objXL.Cells(3 + excelRow, 11).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("DIN EN ISO").ValueAsString
    objXL.Cells(3 + excelRow, 12).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Produktart").ValueAsString

    'Fehlerbehandlung einschalten
    On Error GoTo 0
End Sub
'----------------------------------------

'----------------------------------------
Sub treewalk(byVal oProd As Product, byref lvlCounter As intger, byref eibauLvl as Integer, byVal assyCount As Integer)
dim oChild as Product
dim oDict1 as Object
dim oDict2 as Object
Set oDict1 = CreateObject("Scripting.Dictionary") 'keeps item quantity
Set oDict2 = CreateObject("Scripting.Dictionary") 'keeps part item print state
dim oDict3 as Object
Set oDict3 = CreateObject("Scripting.Dictionary") 'keeps part item print state of prod

' gets components count
for each oChildCount in oProd.Products
if oDict1.Exists(oChildCount.PartNumber) then
oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1
else
oDict1.Add(oChildCount.PartNumber), 1
End If
Next

objXL.Cells(lvlCounter +3, 1).value = eibauLvl
objXL.Cells(lvlCounter +3, 4).value = oProd.PartNumber
objXL.Cells(lvlCounter +3, 3).Value = assyCount

for each oChild in oProd.Products
lvlCounter = lvlCounter + 1
if oChild.Products.Count > 0 then
'product has children
if oDict3.Exists(oChild.PartNumber) = false then
oDict3.Add(oChild.PartNumber), "printed"
TreeWalk oChild, lvlCounter , eibauLvl +1, oDict1.Item(oChild.PartNumber)
end if
else
if oDict2.Exists(oChild.PartNumber) then
lvlCounter = lvlCounter - 1
else
oDict2.Add(oChild.PartNumber), true
WriteToExcel oChild, lvlCounter, oDict1.Item(oChild.PartNumber), eibauLvl +1
end if
end if
next
End Sub

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

---

Servus
hast du dir den Parameter schon in einer MsgBox ausgeben lassen?
Hast su den Code schon in den VBA- Editor kopiert und an der Stelle einen Haltepunkt gesetzt?

Gruß Bernd

EDIT:
Der von dir gepostetet Code läuft bei mir.
Wie ieht dein veränderter Code aus? Was funktioniert nicht? Was mhast du schon alles unterscuht? Wo könnte der Fehler liegen?

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

[Diese Nachricht wurde von bgrittmann am 18. Okt. 2013 editiert.]

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