---

Servus,

laufen tut der Code bei mir auch mit deiner Änderung. Problem ist eben nur das er nur noch Einbaulevel,
Partname und Menge ausgibt und keinerlei Parameter mehr ausließt.

Also den Code den ich gepostet habe ist ja so ziemlich der originale von DasDon und da füge ich die Änderungsvorschläge ein.
Und dann habe ich noch nen zweiten Code als Bastelstube an dem ich rumexperimentier (der ist allerding noch ohne deine Änderung).
Der sieht wie folgt aus:

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

Dim xlSheet    As Excel.Worksheet
dim objXL As Object
dim oAWBook As Object
dim oDict1 As Object
dim sPath As String
sPath = "C:\Users\fulrich\Desktop\Stuecklisten_Makro\Stueckliste\Stueckliste_Vorlage.xls"

'----------------------------------------
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")
Set sPath = objXL.Workbooks.Open(sPath)
Set xlSheet = objXL.ActiveSheet
objXL.Visible = True

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

'----------------------------------------
Sub WriteToExcel(byVal prod As product, byVal i As Integer, byVal quantity As Integer, byVal eibauLvl as Integer)
objXL.Cells(12+i,1).Value = eibauLvl
objXL.Cells(12+i,4).Value = quantity
objXL.Cells(12+i,5).Value = prod.PartNumber
On error resume next
    objXL.Cells(12+i,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString
    objXL.Cells(12+i,11).Value = prod.Parameters.Item("Material").ValueAsString
    objXL.Cells(12+i,23).Value = prod.Parameters.Item("Masse").ValueAsString
    objXL.Cells(12+i,15).Value = prod.Parameters.Item("Durchmesser").ValueAsString
    objXL.Cells(12+i,17).Value = prod.Parameters.Item("Laenge").ValueAsString
    objXL.Cells(12+i,19).Value = prod.Parameters.Item("Breite").ValueAsString
    objXL.Cells(12+i,21).Value = prod.Parameters.Item("Hoehe").ValueAsString
    objXL.Cells(12+i,13).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString
    objXL.Cells(12+i,22).Value = prod.Parameters.Item("Produktart").ValueAsString
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 +12, 1).value = eibauLvl
objXL.Cells(lvlCounter +12, 5).value = oProd.PartNumber
objXL.Cells(lvlCounter +12, 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
'----------------------------------------

Dieser Code schreibt jetzt in meine Vordefinierte Excelvorlage.
Das einzige was noch fehlt, ist das die 3 Paramter der Unterbaugruppen
mit ausgegeben werden und ich versuche gerade rauszufinden ob es einen
Weg gibt mehrere Parameter in einer Zelle auszugeben
>>> "Durchmesser" x "Laenge" x "Breite" x "Hoehe"
Dann muss man zwar die "Nullwerte" per Hand löschen, aber das wird ja wohl kaum
das Problem sein. Weil eine Funktion welche analysiert welche Werte "Null" sind und
diese Werte weglässt ist, so denke ich recht aufwendig und würde den Ramen sprengen xD

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

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

---

Servus
In deinem Code fehlt das ".RootParameterSet.DirectParameters.Item".
Versuch mal an einem TestTeil/Baugruppe direkt vom Product über "RootParameterSet.DirectParameters.Item" den Parameter auszugeben.
Bei mir hat er die Parameter richtig ausgegeben.

Gruß
Bernd

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

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

---

Funktioniert beides nicht?! Immernoch nur die drei Ausgaben...

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

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

---

Ich habe jetzt einen Testbaugruppe bekommen und werde nun das makro so ändern wie Bernd es vorschlug und schauen ob es hinhaut....poste dann das Script bei fertigstellung wieder....

oder auch nicht...habe nur R18 installiert. Vermute du hast es mit R19 gemacht...schade. Kriegen wir auch so hin.

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

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

---

fuck ja wir haben r19...

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

---

einfach...du hast zwei verschiedene Version zusammen gefahren. 

Code:

---

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

---

diese Zeilen (v2) müssen durch diese Zeilen (v4)

Code:

---

WriteToExcel oProd, excelRow, assyCount, instalLvl

---

ausgetacuscht werden...

allerdings hast du die Variablen Namen wie sie in V4 sind, nicht in V2. Warte einfach mal ein wenig und ich korrigiere es....

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

---

Moin Bernd,

Ich habe in VBA-Editor folgendes eingegebn, und als Watch benutzt.

Code:

---

  Sub CATMain()
        CATIA.ActiveDocument.Product.Products.Item (1)
    End Sub

---

Product Structure =

Prod1
-prod2
--part1
--part2
--part2
-prod3
--part3
-prod3
--part3

Schaue ich im Watch Fenster in Parameters.RootParameters finde ich dort the RootParameterSet failed.

Schaue mach ich aber folgendes:

Code:

---

  Sub CATMain()
        Set A = CATIA.ActiveDocument.Product
    End Sub

---

Ist a.Parameters.RootParameters vorhaden, allerdings relative unnützlich (z.Z). Unter DirectParameters ist Count=0 aber im .Units finde ich count=700 und alle Parameter wieder...werde mal ein wenig rumschauen müssen nach eine Lösung die schneller ist als for each...

Gruß,
Dean

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

---

Servus
Hast du auch in den entsprechenden CATParts bzw CATProducts einen Parameter erzeugt?
Sonst wird ein Fehler ausgegeben (Fehlerbehandlung wenn ein Teil nicht den Vorgaben (=Parametern) entspricht)

Gruß
Bernd

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

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

---

Hallo ich hatte ja bereits angesprochen das ich mehrere Parameter in einer Zelle haben möchte.

>>> "Durchmesser"x"Laenge"x"Breite"x"Hoehe"

Dies habe ich wie folgt gelöst:

---------------------------------------------------------------
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
    objXL.Cells(3+i,13).Value = objXL.Cells(3+i,7) & "x" & objXL.Cells(3+i,8) & "x" & objXL.Cells(3+i,9) & "x" & objXL.Cells(3+i,10)
End Sub
---------------------------------------------------------------

Problem ist nun das ich diese Angaben natürlich nur einmal benötige,
daher müssen die 4 Zellen mit den Einzelwerten im Anschluss gelöscht werden.... bloß wie?

Oder es gibt ein Script mit dem direkt alle 4 Paramter zusammen in eine Zelle geschrieben werden können...
...aber dazu habe ich nichts gefunden und selber nur Fehlermeldungen produziert :-P

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

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

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

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

---

Servus
zB so:

Code:

---

sDurchmesser= prod.Parameters.Item("Durchmesser").ValueAsString
sLaenge = prod.Parameters.Item("Laenge").ValueAsString
sBreite = prod.Parameters.Item("Breite").ValueAsString
sHoehe = prod.Parameters.Item("Hoehe").ValueAsString

objXL.Cells(3+i,13).Value = sDurchmesser & "x" & sLaenge  & "x" & sBreite  & "x" & sHoehe

---

oder eben ohne Zwischenvariablen

Gruß
Bernd

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

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

---

Morgen,

funzt wunderbar muss also doch keine Zellen nachträglich löschen.
Vielen Dank.

Gibt es eine Möglichketi die Maßeinheit zu löschen?
Momentan  steht es so da:

0mmx20mmx20mmx20mm

soll aber so sein

0x20x20x20

Ich habe es über eine Excelformatierung versucht, aber selbst wenn
die Zellen auf Zahlen formatiert sind behält er die "mm" bei.
Versucht habe ich auch statt "asString" "asInteger" einzusetzen, allerdings überträgt er dann gar keine Daten mehr...
...und wieder was gelernt xD

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

---

Servus
Entweder über "replace" oder zB:

Code:

---

sHoehe = CStr(prod.Parameters.Item("Hoehe").Value)

---

Gruß
Bernd

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

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

---

Wunderbar Vielen vielen Dank.

Also nur mit der Angabe "Value" werden nur die Zahlen
ausgelesen?

Ok cool :-)

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

---

Moinmoin und mal wieder ein Problem xD

ich möchte eine inputbox erstellen die mehrere Daten abfrägt und dann
in Excel eintragen soll.

Code V1:

dim myFunc1 As String
myFunc1 = InputBox ("Bitte Ihren Nachnamen eingeben.", "Bearbeiter", "Nachname")
objXL.Cells(3,6).Value = myFunc1.ValueAsString

>>>Bei dieser Version kommt nach der Eingabe eine Fehlermeldung: Objekt erforderlich: 'myFunc1'

Code V2:

dim myFunc1 As String
myFunc1 = InputBox ("Bitte Ihren Nachnamen eingeben.", "Bearbeiter", "Nachname")
objXL.Cells(3,6).Value = myFunc1

>>>Hier kommt keine Fehlermeldung aber es wird auch nichts in Excel geschrieben...

Was mach ich falsch?!?!

Und gibt es eine Möglichkeit mehrere Angaben in einer Inputbox abzufragen? Habe hierzu nicht viel hilfreiches gefunden im Bereich Excel selber gabs ne Menge was mir allerdings nicht weitergeholfen hat :-(

Grüße

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

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

---

Hallo,

mit "Code V2" soll es funktionieren.

Wohin hast Du die Code zugefügt?
Kann es sein, wird später diese Zelle überschreiben?

[Diese Nachricht wurde von imation1999 am 28. Okt. 2013 editiert.]

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

---

Also mit V2 geb ich den Wert ein und das Makro läuft dann komplett durch ohne Fehlermeldung.

Aber er schreibt den Wert nicht in besagte Zelle.

Nein die wird nicht überschrieben.
Alle Zellen welche von dem Makro genutzt werden liegen unterhalb.

Hier ist die Codezeile eingebaut:

Dim xlSheet    As Excel.Worksheet
dim objXL As Object
dim oAWBook As Object
dim oDict1 As Object
dim oDict2 As Object
dim oDict3 As Object
dim sPath As String
sPath = "C:\Users\fulrich\Desktop\Stuecklisten_Makro\Stueckliste\Stueckliste_Vorlage.xls"
'----------------------------------------
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")
Set sPath = objXL.Workbooks.Open(sPath)
Set xlSheet = objXL.ActiveSheet
objXL.Visible = True

dim myFunc1 As String
myFunc1 = InputBox ("Bitte Ihren Nachnamen eingeben.", "Bearbeiter", "Nachname")
objXL.Cells(3,6).Value = myFunc1.ValueAsString
.......

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

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

---

Servus
Code V2 sollte eigentlich passen. hast du auch einen Namen angeben (mit MsgBox ausgeben lassen)? Wie hast du den Fehler schon untersucht bzw eingeschränkt?
In CATScript kannst du nur Inputboxen mit einem Input verwenden (oder zB Input mit Komma trennen und dann entsprechend prüfen und zerlegen). Oder du musst auf VBA (bzw CATVBA) wechseln.

Gruß
Bernd

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

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

---

Wie mit msgBox ausgeben?   

Hab nur das geschrieben was oben steht...  

Neeee dann lieber mehrere Intuptboxen weil das ganze jetzt umschreiben...
...da fang ich ja wieder bei Null an 

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

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

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

---

Servus
Probiere es mal mit:

Code:

---

xlSheet.Cells(3,6).Value = myFunc1

---

Gruß
Bernd

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

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

---

Haha so ein f.....
mein ursprünglicher Code hat eigentlich auch gefunzt Problem war
nur das ich in eine Excelvorlage schreibe und diese Zelle war falschformatiert. Hab die Formatierung gelöscht und beides ausprobiert
und beides hat funktioniert xD.

Aber natürlich trotzdem Vielen Dank :-)

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

---

Sooo der vorletzte Schritt... nun ist es daran das ganze etwas übersichtlicher zu machen...
...den Großteil hat ja dasDon geschrieben (Vielen Dank nochmal)

und das Makro schreibt zuerst alle Baugruppen auf, dann macht es zwei
Leerzeilen rein und dann kommen die restlichen Parts.
So ich möchte jetzt aber nach jeder Unterbaugruppe eine Leerzeile haben.
Ich such mir schon nen Wolf in dem Script, veränder Wert um Wert und es passiert alles nur nicht das was ich will  

Weiß einer von euch wo das definiert ist oder definiert werden muss? oO

Code:
--------------------------------------------------------------------
Dim xlSheet    As Excel.Worksheet
dim objXL As Object
dim oAWBook As Object
dim oDict1 As Object
dim oDict2 As Object
dim oDict3 As Object
dim sPath As String
sPath = "C:\Users\Stueckliste_Vorlage.xls"

'----------------------------------------
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")
Set sPath = objXL.Workbooks.Open(sPath)
Set xlSheet = objXL.ActiveSheet
objXL.Visible = True

'Eingabeaufforderungen für den Schriftkopf
dim myFunc1 As String
myFunc1 = InputBox ("Bitte geben Sie Ihren Namen ein.", "Angabe 1 von 8", "V.Name")
objXL.Cells(6,4).Value = myFunc1

dim myFunc2 As String
myFunc2 = InputBox ("Bitte geben Sie das aktuelle Datum ein.", "Angabe 2 von 8", "XX.YY.CCCC")
objXL.Cells(7,4).Value = myFunc2

dim myFunc3 As String
myFunc3 = InputBox ("Bitte geben Sie Auftragsnummer ein.", "Angabe 3 von 8", "XXXXXXXX-Y-CC")
objXL.Cells(4,6).Value = myFunc3
objXL.Cells(6,6).Value = myFunc3
objXL.Cells(5,11).Value = myFunc3

dim myFunc4 As String
myFunc4 = InputBox ("Bitte geben Sie die Bezeichnung der Baugruppe ein.", "Angabe 4 von 8", "XXXXXXXX-Y-CC_Bezeichnung")
objXL.Cells(5,6).Value = myFunc4

dim myFunc5 As String
myFunc5 = InputBox ("Bitte geben Sie den Kunden ein.", "Angabe 5 von 8", "Kunde")
objXL.Cells(6,9).Value = myFunc5

dim myFunc6 As String
myFunc6 = InputBox ("Bitte geben Sie die Baugruppe ein.", "Angabe 6 von 8", "Baugruppe")
objXL.Cells(7,9).Value = myFunc6

dim myFunc7 As String
myFunc7 = InputBox ("Bitte geben Sie den Gerätetyp ein.", "Angabe 7 von 8", "Gerätetyp")
objXL.Cells(7,6).Value = myFunc7

dim myFunc8 As String
myFunc8 = InputBox ("Bitte geben Sie den Kostenträgere ein.", "Angabe 8 von 8", "Kostenträgere")
objXL.Cells(4,11).Value = myFunc8
End Sub
'----------------------------------------

'----------------------------------------
Sub WriteToExcel(byVal prod As product, byVal i As Integer, byVal quantity As Integer, byVal eibauLvl as Integer)
'Print-Ziel festlegen
objXL.Cells(11+i,1).Value = eibauLvl
objXL.Cells(11+i,3).Value = quantity
objXL.Cells(11+i,4).Value = prod.PartNumber
On error resume next

sDurchmesser=  CStr(prod.Parameters.Item("Durchmesser").Value)
sLaenge =  CStr(prod.Parameters.Item("Laenge").Value)
sBreite =  CStr(prod.Parameters.Item("Breite").Value)
sHoehe = CStr(prod.Parameters.Item("Hoehe").Value)

    objXL.Cells(11+i,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString
    objXL.Cells(11+i,7).Value = prod.Parameters.Item("Material").ValueAsString
objXL.Cells(11+i,9).Value = "d" & sDurchmesser & "x" & sLaenge  & "x" & sBreite  & "x" & sHoehe
    objXL.Cells(11+i,8).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString
    objXL.Cells(11+i,10).Value = prod.Parameters.Item("Produktart").ValueAsString
    objXL.Cells(11+i,11).Value = prod.Parameters.Item("Masse").ValueAsString
End Sub
'----------------------------------------

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

'Teile zählen
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 +11, 1).value = eibauLvl
objXL.Cells(lvlCounter +11, 4).value = oProd.PartNumber
objXL.Cells(lvlCounter +11, 3).Value = assyCount

for each oChild in oProd.Products
lvlCounter = lvlCounter + 1
if oChild.Products.Count > 0 then

'Product hat Kind
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
------------------------------------------------------------------

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

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

---

Servus
Vermutlich musst du dort wo der Treewalk für die Unterbaugruppe aufgerufen wird nur den Zähler um eins erhöhen (+2 statt +1)

Gruß
Bernd

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

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

---

Das hatte ich auch schon vermutet aber wenn ich den Wert auf 2 stelle,
dann zählt er einfach nur falsch xD

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

---

Servus
Was zählt er falsch?
Schon mal probiert an der gleichen Stelle den "lvlCounter" um eins zu erhöhen?

Gruß
Bernd

PS: Bitte erklär besser was nicht geht, so allgemeine Aussagen "geht nicht" bringen niemandem etwas. Ggf antworten weniger Leute, da sie nicht Lust haben dir "alles aus der Nase zu ziehen"

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

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

---

Wenn ich den Wert welchen du gesagt hast erhöhe, zählt er die Bauteile falsch. Also er gibt mehr Parts an als eigentlich enthalten sind im 3D.
Erhöhe ich den "lvlCounter" auf 2 macht er nach jedem Element eine Leerzeile wodurch die Liste dann extrem gestrekt ist.
Es soll aber nur nach jeder Baugruppe eine Leerzeile rein.

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

'Teile zählen
for each oChildCount in oProd.Products
if oDict1.Exists(oChildCount.PartNumber) then
oDict1.Item(oChildCount.PartNumber) = oDict1.Item(oChildCount.PartNumber) +1 (erhöhe ich den Wert werden die Parts falsch gezählt)
else
oDict1.Add(oChildCount.PartNumber), 1 (Erhöhe ich den Wert auf 2 wird zu jedem enthaltenem Element "1" mehr dazu gezählt)
End If
Next

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

for each oChild in oProd.Products
lvlCounter = lvlCounter + 1
if oChild.Products.Count > 0 then

'Product hat Kind
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

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

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

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

---

Servus
Du hast das Makro noch nicht verstanden (bitte mal schrittweise abarbeiten lassen und versuchen nachzuvollziehen). Ich meine in der Zeile

Code:

---

TreeWalk oChild, lvlCounter , eibauLvl +1, oDict1.Item(oChild.PartNumber)

---

entweder den "lvlCounter" oder den "eibauLvl" variieren (eher lvlCounter)

Gruß
Bernd

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

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

---

Achso ok...
...ja bin dabei ständig zu schauen was für was ist... dauert aber noch ein wenig glaub eich ;-)

Also sehr komisches Ergebnis:

Wenn ich eibauLvl erhöhe wird genau der Wert einfach nur in Excel erhöht.
Änder ich allerdings lvlCounter macht er was sehr merkwürdiges. In Excel erscheinen Daten die er eingibt und diese
werden dann ständig überschrieben, hüpfen hin und her uund letztendlich stehen dann alle Products untereinander
und dann alle Parts und von Leerzeilen keine Spur :-P

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

---

Ich habe jetzt hier noch den Wert "+1" dahintergeschrieben:

WriteToExcel oChild, lvlCounter +1, oDict1.Item(oChild.PartNumber), eibauLvl +1

Dann macht er auch tatsächlich hinter jedem Product eine Leerzeile.
Problem hierbei ist das dies so nicht gedacht ist. Er soll ja nach einer kompletten Baugruppe erst eine Leerzeile machen damit es übersichtlicher ist also so:

Product1
- PartX
- PartY

Product2
- PartZ
...

Er macht es allerdings so:

Product1

- PartX
- PartY
Product2

- PartZ
...

    

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

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

---

versuch mal so:

Code:

---

oDict2.Add (oChild.PartNumber), True
WriteToExcel oChild, lvlCounter, oDict1.Item(oChild.PartNumber), eibauLvl + 1
End If
End If
Next
lvlCounter = lvlCounter + 1
End Sub

---

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

---

Moin moin,

das Problem liegt bei der For-Schleife. Da er die Parts gruppieren muss, muss ständige der Excelreihezähler verändert, bzw angepasst werden.

Dies geschieht bei Parts hier:

if oDict2.Exists(oChild.PartNumber) then
lvlCounter = lvlCounter - 1

bei Baugruppen habe ich es wohl vergessen. Die Leerezeilen tauchen dann auf, sobald eine Baugruppe mehr als einmal Installiert ist.
Der lvlCounter wird hochgezählt für jedes Kind. Um das zu lösen, muss bei der Fesetullung das die Baugruppe schon exportiert werden, wieder der Zähler nach unten korrigiert werden.  Folgendes muss hinzugefügt werden:

Code:

---

    'Product hat Kind
   if oDict3.Exists(oChild.PartNumber) = false then
       oDict3.Add(oChild.PartNumber), "printed"
       TreeWalk oChild, lvlCounter , eibauLvl +1, Dict1.Item(oChild.PartNumber)
       lvlCounter = lvlCounter + 1 ' damit erzeugt man die Leerzeile nach jeder Baugruppe
   else
      lvlCounter = lvlCounter - 1 'anpassung der Excelreihe
   end if

---

Damit müsste es hinhauen.

Gruß,
Dean

PS: ich würde aber eigentlich davon abraten, eine leere Zeile in Excel hinzu zu fügen, damit werden die Filter etwas komplizierter. Lieber würde ich eine Extra Sub hinzufügen der die Reihe Untersctriecht oder Fett macht...

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

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

---

Perfekt funktioniert wunderbar :-)
Vielen Dank ;-)

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

---

Ich kenn jetzt nur den Befehl:

objXL.Cells(1,9).Font.Bold = True

Wie mach ich das im Sub fett?

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

---

Moin,

wäre das hier evtl nicht etwas besser als die ganzen benutzer eingaben?

Code:

---

        myFunc1 = CATIA.SystemService.Environ("USERNAME") 'angabe 1 von 8
        myFunc2 = CStr(Date) 'angabe 2 von 8
        myFunc4 = CATIA.ActiveDocument.Product.Nomenclature  ' angabe 4 von 8
        myFunc6 = CATIA.ActiveDocument.Product.PartNumber ' angabe 6 von 8

---

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

---

Cool ja das hat was xD

Wie soll das mit dem Fett machen funzen was du gesagt hast?

Grüße

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

---

Moin,

so:

objXL.Cells(lvlCounter +3, 1).value = eibauLvl
objXL.Cells(lvlCounter +3, 3).Value = assyCount
objXL.Cells(lvlCounter +3, 4).value = oProd.PartNumber
objXL.Rows(lvlCounter +3).Font.Bold = True ' Baugruppe wird Fettgedruckt

gruß,
Dean

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

---

Ah ok...

...mann mann das wird dauern bis ich das alles richtig drauf habe...

Vielen Dank 

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

---

shoutz000_v5.CATSCript.txt

Moin moin,

Ich hatte mal wieder etwas Zeit das hier genauer an zuschauen und möchte es nun abzuschließen:

Bernd, du hattest Recht mit dem RootParameterSet.DirectParameters! Allerdings Funktioniert das nur bei Assemblies. Darum habe ich einen String(passedType) übergeben beim Aufruf vom WriteToExcel der angibt ob das Kind einen Part oder einen Product ist.

Code:

---

'Fehlerbehandlung abschalten
    On Error Resume Next
Select Case passedType
case "Product"
objXL.Cells(excelRow,2).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Pos_Nr.").ValueAsString
objXL.Cells(excelRow,8).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("DIN EN ISO").ValueAsString
objXL.Cells(excelRow,10).Value = prod.Parameters.RootParameterSet.DirectParameters.Item("Produktart").ValueAsString
case "Part"
'collect dimension parameters
sDurchmesser=  prod.Parameters.Item("Durchmesser").ValueAsString
sLaenge =  prod.Parameters.Item("Laenge").ValueAsString
sBreite =  prod.Parameters.Item("Breite").ValueAsString
sHoehe = prod.Parameters.Item("Hoehe").ValueAsString
'Parameter auslesen und in Excel eintragen
objXL.Cells(excelRow,2).Value = prod.Parameters.Item("Pos_Nr.").ValueAsString
objXL.Cells(excelRow,7).Value = prod.Parameters.Item("Material").ValueAsString
objXL.Cells(excelRow,9).Value = "d" & sDurchmesser & "x" & sLaenge  & "x" & sBreite  & "x" & sHoehe
objXL.Cells(excelRow,8).Value = prod.Parameters.Item("DIN EN ISO").ValueAsString
objXL.Cells(excelRow,10).Value = prod.Parameters.Item("Produktart").ValueAsString
objXL.Cells(excelRow,11).Value = prod.Parameters.Item("Masse").ValueAsString
End Select
    'Fehlerbehandlung einschalten

---

Anbei ist auch das Komplette Makro.

Gruß,
Dean

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

---

1.jpg

Hallo,
Hätte eine Frage zur Stückliste.
Die Stückliste funktioniert soweit ganz gut es gibt aber zwei Sachen die für mich nicht ganz passen.

- Wenn ein Produkt öfters in einem Produkt verbaut ist und dieses Parts beinhaltet, wird nur die Menge  vom Produkt und nicht vom den Part gezählt. (gelb markiert)
- Gibt es die Möglichkeit das die Produkte nicht in der Stückliste aufgenommen werden.(blau markiert)
- Gibt es die Möglichkeit das Basismodelle (Parts) nicht in der Stückliste mit aufgenommen werden..(orange markiert)

wer hätte da eine Idee

Danke

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

---

Servus

Bevor du das Makro an deine Vorgaben anpasst, stelle ich ein paar (auch provokante) Fragen:
- warum hast du gerade diese Makro rausgesucht?
- hast du auch mal andere Makros hier im Forum angeschaut (Stückliste, BOM, ...)?
- hast du dir die Catia-internen Möglichkeiten zur Stücklistengenerierung angeschaut?
- wenn du die Unterbaugruppen auflöst, müssten dann nicht die Unterbaugruppen an sich aus der Liste verschwinden (bzw auf 0 gehen)? Sonst wäre es ja doppelt

Gruß
Bernd

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

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

---

Hallo

- warum hast du gerade diese Makro rausgesucht?
Das Makro funktionier soweit ganz gut bis auf die Tatsache das wenn ein Produkt öfters verbaut werden die Parts nicht hochgezählt werden javascript:InsertSMI(' %20');  nur das Produkt.

- hast du auch mal andere Makros hier im Forum angeschaut
(Stückliste, BOM, ...)?
Ja habe ich habe nichts vergleichbar gutes gefunden.
- hast du dir die Catia-internen Möglichkeiten zur
Stücklistengenerierung angeschaut?
Ja habe mir angeschaut, da habe ich leider nicht solle Freiheiten wie mit einem Makro und kann auch ein Excel Template verwenden.
- wenn du die Unterbaugruppen auflöst, müssten dann nicht die Unterbaugruppen an sich aus der Liste verschwinden (bzw auf 0 gehen)? Sonst wäre es ja doppelt.

wie könnte das mit dem nicht hochzählen der Part gelöst werden ?

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

---

Servus

Kurze Rückfrage: was soll passieren, wenn ein Einzelteil in verschiedenen Unterbaugruppen verbaut ist (zB Schrauben)? (sieh zB auch hier)

Gruß
Bernd

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

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

---

Danke für dein Hilfe.
Mach es jetzt ganz anders, umständlich aber es Funktioniert.
Erstelle per Makro eine Catia "Bill" mit den gewünschten Informationen
da öffne ich eine Standard Stückliste und lasse mir diese dann per VBA von der Catia in die Standard Stückliste übertragen.
Somit habe ich nicht das mit den Produkten und die Mengenangabe stimmt auch.

Danke nochmals für deine Mühen

-----------------------------------------------------------------
Catia
-----------------------------------------------------------------

Sub CATMain()

Set productDocument1 = CATIA.ActiveDocument

Set product1 = productDocument1.Product

Set assemblyConvertor1 = product1.GetItem("BillOfMaterial")

Dim arrayOfVariantOfBSTR2(13)
arrayOfVariantOfBSTR2(0) = "Pos Nr.:"
arrayOfVariantOfBSTR2(1) = "Menge"
arrayOfVariantOfBSTR2(2) = "Bauteil Bezeichnung"
arrayOfVariantOfBSTR2(3) = "Abmessung Länge"
arrayOfVariantOfBSTR2(4) = "Abmessung Breite"
arrayOfVariantOfBSTR2(5) = "Abmessung Höhe"
arrayOfVariantOfBSTR2(6) = "Werkstoff"
arrayOfVariantOfBSTR2(7) = "Bestellbezeichnung"
arrayOfVariantOfBSTR2(8) = "Hersteller"
arrayOfVariantOfBSTR2(9) = "Anmerkung"
arrayOfVariantOfBSTR2(10) = "Wärmebehandlung"
arrayOfVariantOfBSTR2(11) = "Oberflächenschutz"
arrayOfVariantOfBSTR2(12) = "PLM Nummer"
arrayOfVariantOfBSTR2(13) = "Typ"

assemblyConvertor1.SetSecondaryFormat arrayOfVariantOfBSTR2

assemblyConvertor1.Print "XLS", "C:\Users\Public\Documents\Liste.xls", product1

Set objXL = GetObject("H:\21_Standard Aufbau\Stückliste.xlsm")
objXL.Application.Visible = True
objXL.Parent.Windows(1).Visible = True
 
End Sub

------------------------------------------------------------------
Ecxel
------------------------------------------------------------------
Sub Kopieren()

Set Catiapart = Workbooks.Open("C:\Users\Public\Documents\Liste.xls")

'Sheets.Add After:=Sheets(Sheets.Count)

Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 1
For i = 1 To 10000
With Worksheets("Tabelle1")
If .Cells(i, "N") = "Teil" Then
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 1).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 1).Value ' Pos Nr.:
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 2).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 2).Value ' Menge
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 3).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 3).Value ' Bauteil Bezeichnung
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 4).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 4).Value ' Abmessung Länge
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 5).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 5).Value ' Abmessung Breite
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 6).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 6).Value ' Abmessung Höhe
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 7).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 7).Value ' Werkstoff
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 8).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 8).Value ' Bestellbezeichnung
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 9).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 9).Value ' Anmerkung
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 10).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 10).Value ' Wärmebehandlung
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 11).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 11).Value ' Oberflächenschutz
Workbooks("Stückliste.xlsm").Sheets("Stückliste").Cells(7 + a, 12).Value = Workbooks("Liste.xls").Sheets("Tabelle1").Cells(i, 12).Value ' PLM Nummer

a = a + 1
Else
End If
End With
Next i
Application.ScreenUpdating = True

Catiapart.Close savechanges:=False

End Sub

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

---

Servus

Und was ist daran jetzt umständlicher als beim anderen Code?
Das Kopieren und Einfügen lässt sich sicher noch optimieren. (ggf mit .Rang.Copy oder .Cell.Copy)

Gruß
Bernd

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

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