Dieses Makro funktioniert gut und ich danke Ihnen dafür. Zwei kleine Anmerkungen habe ich allerdings:
Es wird nicht berücksichtigt, ob Teile als "von der Stückliste ausgeschlossen" definiert sind oder nicht. Alle Dokumente stechen in der Excel-Tabelle hervor.
Bei mechanisch geschweißten Teilen exportiert das Makro jeden geschweißten Körper als eigenständiges Teil, wenn diese Körper aus der Nomenklatur ausgeschlossen werden sollten (naja, in meinem Fall).
Ist es möglich, diese 2 kleinen Probleme durch ein zusätzliches Stück Code zu lösen?
Wenn es nicht möglich ist, sie auszublenden, ist es vielleicht möglich, der Excel-Datei eine Spalte mit der Eigenschaft "Von Stückliste ausgeschlossen" und als Wert in jeder JA- oder NEIN-Zeile hinzuzufügen.
Ich weiß nicht, von welchem Makro Sie genau ausgegangen sind und welche Änderungen Sie vorgenommen haben, aber es ist immer noch seltsam, dass Teile, die von der Nomenklatur ausgeschlossen sind, in dieser Nomenklatur erscheinen (es sei denn, sie sind in einer Konfiguration aus der Nomenklatur ausgeschlossen, aber nicht in der, aus der Sie die Nomenklatur erhalten).
Bei mechanisch geschweißten Teilen liegt dies wahrscheinlich an dem für die Erstellung der Stückliste gewählten swBomType :
- "Eingerückt": alle Ebenen einschließlich der Profile der mechanisch geschweißten.
- "TopLevelOnly": nur die erste Ebene, also nicht die Profile der mechanisch geschweißten.
Auf diesem Link scheinen mir alle nützlichen Informationen zu sein.
Vielen Dank für Ihre Antwort. Ja, ich hatte das Diskussionsthema gesehen, das du erwähnst. Wenn ich den swBomType auf "TopLevelOnly" ändere, habe ich eigentlich nur die 1. Ebene, mir fehlen also alle Unterebenen. Wenn ich den swBomType in "Indented" setze, geht es runter bis zum Korpus der mechanisch geschweißten Teile, der einen zu niedrigen Boden darstellt.
Option Explicit
Sub main()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet
With xlApp
' .Visible = True
Set wbk = .Workbooks.Add
Set sht = wbk.ActiveSheet
End With
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim swBOMFeature As SldWorks.BomFeature
Dim boolstatus As Boolean
Dim BomType As Long
Dim Configuration As String
Dim TemplateName As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
TemplateName = "C:\Users\vousm\Documents travail\Config_Sw\Table nomenclature\table_nomenclature.sldbomtbt"
'BomType = swBomType_Indented
BomType = swBomType_TopLevelOnly
Configuration = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox Configuration
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature
swModel.ForceRebuild3 True
Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Dim J As Long
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
'mise en forme
For I = 1 To NumRow - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(I + 1).RowHeight = 15
Next I
For J = 0 To NumCol - 1
xlApp.ActiveSheet.Cells(1, J + 1).Interior.ColorIndex = 15
Next J
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(1).ColumnWidth = 6
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(2).ColumnWidth = 17
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(3).ColumnWidth = 4
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(4).ColumnWidth = 34
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(5).ColumnWidth = 34
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(6).ColumnWidth = 4
For I = 0 To NumRow - 1
For J = 0 To NumCol - 1
If J <> 5 Then 'cas de la colonne Qté
xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"
End If
xlApp.ActiveSheet.Cells(I + 1, J + 1).VerticalAlignment = 2
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete
Dim chemin As String
chemin = "C:\temp\BOS4.xlsx"
With xlApp
wbk.SaveAs chemin
wbk.Close
.Quit
End With
End Sub
Wie können wir das dann tun? Vielen Dank für Ihr Feedback,
In diesem Fall ist es möglich, swBomType auf "Indented" zu setzen und die Komponente für jede Zeile der Stückliste mit der Funktion Getcomponents2 abzurufen, um zu entscheiden, ob sie in die Excel-Datei eingefügt werden soll oder nicht. Möglicherweise müssen Sie für jede Komponente am ModelDoc2-Objekt festhalten, um sie zu analysieren. Dies kann mit der Funktion GetModelDoc2 erfolgen.
Wow, wir werden an die Grenzen meiner Programmierkenntnisse stoßen.
Ich habe den Eindruck, dass alles auf die Zeile "Set swBOMAnnotation = swModelDocExt.InsertBomTable3... ", wo die Nomenklatur erstellt wird. Bereits hier erscheinen die Körper des Schweißteils. Im Anhang das betreffende Dokument. Da SW durch manuelles Ändern der Parameter der Nomenklatur kann ich diese Körper nicht ausblenden. Auch das Deaktivieren des Kontrollkästchens "Detaillierte Liste der geschweißten Teile" hilft nicht. Was ist in diesem Fall zu tun?
Hier ist eine mögliche Lösung, ich bin von dem Makro ausgegangen, das ich bereits erstellt hatte, also muss es an Ihren Fall angepasst werden, aber das Prinzip ist: Für jede Zeile der Nomenklatur bekomme ich das ModelDoc, um es zu analysieren und zu sehen, ob es sich um eine Schweißkonstruktion handelt, wenn es der Fall ist und dass dieses ModelDoc2 das gleiche ist wie die vorherige Zeile, dann muss ich mir darüber keine Sorgen machen. berücksichtigt dies beim Export nach Excel nicht. Ich habe meine Tests an einer meiner Baugruppen gemacht, weil ich die Halterung (zukünftige Version) nicht öffnen kann.
Herzliche Grüße
Option Explicit
Sub main()
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet
With xlApp
.Visible = True
Set wbk = .Workbooks.Add
Set sht = wbk.ActiveSheet
End With
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim swBOMFeature As SldWorks.BomFeature
Dim boolstatus As Boolean
Dim BomType As Long
Dim Configuration As String
Dim TemplateName As String
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"
BomType = swBomType_Indented
Configuration = "Défaut"
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature
swModel.ForceRebuild3 True
Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Dim J As Long
Dim H As Long
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(1).RowHeight = 40
For I = 1 To NumRow - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(I + 1).RowHeight = 20
Next I
For J = 0 To NumCol - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(J + 1).ColumnWidth = 25
xlApp.ActiveSheet.Cells(1, J + 1).Interior.ColorIndex = 15
Next J
H = 1
For I = 0 To NumRow - 1
Dim vPtArr As Variant
Dim swcomp As Component2
Dim comp As ModelDoc2
Dim Titre As String
Dim newTitre As String
Dim FeatName As String
Dim printOk As Boolean
printOk = False
FeatName = ""
vPtArr = swBOMAnnotation.GetComponents2(I, Configuration)
If (Not IsEmpty(vPtArr)) Then
Set swcomp = vPtArr(0)
Set comp = swcomp.GetModelDoc2
newTitre = comp.GetTitle
Dim swfeat As Feature
Set swfeat = comp.FirstFeature
Do While Not swfeat Is Nothing
If swfeat.Name = "Construction soudée" Then
FeatName = "Construction soudée"
End If
Set swfeat = swfeat.GetNextFeature
Loop
End If
If FeatName = "Construction soudée" Then
If Not Titre = newTitre Then
printOk = True
End If
Else
printOk = True
End If
If printOk = True Then
For J = 0 To NumCol - 1
xlApp.ActiveSheet.Cells(H, J + 1).NumberFormat = "@"
xlApp.ActiveSheet.Cells(H, J + 1).VerticalAlignment = 2
sht.Cells(H, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
H = H + 1
End If
Titre = newTitre
Next I
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete
swModel.ForceRebuild3 True
Dim chemin As String
chemin = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & ".xlsx"
With xlApp
wbk.SaveAs chemin
wbk.Close
.Quit
End With
End Sub
Vielen Dank, dass Sie sich die Zeit genommen haben, sich mein Problem anzusehen. Also habe ich mein Makro mit Ihren Empfehlungen modifiziert. Wenn ich das richtig verstehe, durchläuft das Makro alle Konstruktionslinien des Teils und prüft, ob es einen Text "Schweißkonstruktion" findet. Alles passiert in dieser Schleife:
Do While Not swfeat Is Nothing
Debug.Print swfeat.Name
If swfeat.Name = "Construction soudée" Then
FeatName = "Construction soudée"
End If
Set swfeat = swfeat.GetNextFeature
Loop
Auf mein Teil angewendet, geht die Schleife über die Funktionen, aber nicht über "Liste der geschweißten Teile". Ich habe eine Debug.Print-Datei hinzugefügt. Name, um zu sehen, was dabei herauskommt:
Favoris
Historique
Ensembles de sélections
Capteurs
Classeur de conception
Annotations
Marquages
Lumières, caméras et scène
Corps volumiques
Surface Bodies
Commentaires
Equations
S235
im Vergleich zur Baumstruktur meines Zimmers (siehe Anhang).
Artikel-Liste... genau in der Mitte des restlichen Baumes im Raum. Das ist seltsam. Nun, ich sollte es schaffen, da rauszukommen, indem ich nachschaue, ob ich das Wort "geschweißt" in der Datei habe. Name. Das einzige Problem bei dieser Methode ist, dass man aufpassen muss, die geschweißten Körper nicht umzubenennen.
Hier ist das modifizierte Code-Snippet, falls es jemals jemand braucht
Do While Not swfeat Is Nothing
Debug.Print swfeat.Name
If InStr(1, swfeat.Name, "soudée") <> 0 Then
'If swfeat.Name = "soudée" Then
FeatName = "Construction soudée"
End If
Set swfeat = swfeat.GetNextFeature
Loop
Danke d.roger
Ich weiß nicht, wie Ihr SolidWorks aussieht, aber es muss die Konstruktion fast selbst durchführen, indem Sie einfach auf ein Makro klicken:-D
Seien Sie vorsichtig, von Zeit zu Zeit müssen Sie den Makro-Editor schließen und erneut öffnen (ohne zu vergessen, Ihr Makro zuerst zu speichern), mir ist aufgefallen, dass es nach einer Weile der Nutzung ein wenig Schwierigkeiten hat, sich aufzufrischen, es kann auch von dort kommen ...
In meinem Makro suche ich nach der Funktion "Schweißkonstruktion", die sich auch beim Umbenennen der geschweißten Körper nicht ändert:
Was meine SW betrifft, nein, sie macht das Design nicht von selbst, indem sie auf ein Makro klickt, obwohl es für einige Teile nicht sehr weit davon entfernt ist :-)
Sie müssen darüber nachdenken, die beste Antwort zu validieren, wenn es eine gibt, die der Anfrage entspricht, sie kann anderen Benutzern helfen, die wahrscheinlich die gleiche Art von Anfrage haben ...
Und nur zum Spaß, das Video ist von schlechter Qualität, aber es zeigt, wie SW ein Triebwerk durch Evolvente eines Kreises fast von selbst zeichnen kann :-)
