VBA Excel zum Einfügen von SW-BOM

Macro
,
1

Hallo, ich benutze VBA in Excel, um eine Materialliste zu erstellen, ohne es manuell in SolidWorks zu machen. Ich habe bereits ein Makro, das zum Erstellen von Montageplänen funktioniert, und möchte daher gerne eine Stückliste erstellen, aber ich drehe mich im Kreis (Fehlerzeile: Wenn nicht swView.GetModel dann nichts ist):

Option Explicit

Sub InsererBOMAssemblage()
    Dim swApp As Object
    Dim swModel As Object
    Dim swDraw As Object
    Dim swSheet As Object
    Dim swView As Object
    Dim swBOM As Object
    Dim cheminPlan As String
    Dim cheminBOM As String
    Dim erreur As Long
    Dim avertissement As Long
    
    cheminPlan = "chemin du plan d'assemblage" ' <-- modifier selon ton fichier"
    cheminBOM = "chemin de la nomenclature" ' <-- modèle de nomenclature
    
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application")
    If swApp Is Nothing Then
        Set swApp = CreateObject("SldWorks.Application")
        If swApp Is Nothing Then
            MsgBox "Impossible de lancer SolidWorks.", vbCritical
            Exit Sub
        End If
        swApp.Visible = True
    End If
    On Error GoTo 0
    
    Set swModel = swApp.OpenDoc6(cheminPlan, 3, 0, "", erreur, avertissement)
    If swModel Is Nothing Then
        MsgBox "Impossible d'ouvrir le plan : " & cheminPlan & vbCrLf & _
               "Erreur = " & erreur & ", Avertissement = " & avertissement, vbCritical
        Exit Sub
    End If
    
    Set swDraw = swModel
    
    Set swSheet = swDraw.GetCurrentSheet
    If swSheet Is Nothing Then
        MsgBox "Impossible de récupérer la feuille du plan.", vbCritical
        Exit Sub
    End If
    
    Set swView = swDraw.GetFirstView
    Do While Not swView Is Nothing
        If Not swView.GetModel Is Nothing Then
            Exit Do
        End If
        Set swView = swView.GetNextView
    Loop
    
    If swView Is Nothing Then
        MsgBox "Aucune vue valide (pièce ou assemblage) trouvée. Ajoute une vue dans le plan.", vbCritical
        Exit Sub
    End If
    
    On Error Resume Next
    Set swBOM = swDraw.InsertBomTable(swView, 0.1, 0.1, 0, cheminBOM)
    On Error GoTo 0
    
    If swBOM Is Nothing Then
        MsgBox "Erreur lors de l'insertion de la nomenclature. Vérifie la vue et le chemin du modèle BOM.", vbCritical
    Else
        swDraw.EditRebuild3
        MsgBox "Nomenclature insérée avec succès !", vbInformation
    End If
End Sub
2

Hallo und herzlich willkommen;

Ich empfehle das " Codestack "-Makro
https://www.codestack.net/solidworks-api/document/tables/insert-bom-table/

'**********************
'Copyright(C) 2025 Xarial Pty Limited
'Reference: https://www.codestack.net/solidworks-api/document/tables/insert-bom-table/
'License: https://www.codestack.net/license/
'**********************

Const ANCHOR_TYPE As Integer = swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopLeft
Const BOM_TYPE As Integer = swBomType_e.swBomType_PartsOnly
Const TABLE_TEMPLATE As String = ""
Const INDENTED_NUMBERING_TYPE As Integer = swNumberingType_e.swNumberingType_Flat
Const DETAILED_CUT_LIST As Boolean = False
Const FOLLOW_ASSEMBLY_ORDER As Boolean = True

Const ALL_SHEETS As Boolean = True
Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks    
    Dim swDraw As SldWorks.DrawingDoc    
    Set swDraw = swApp.ActiveDoc
    
    If ALL_SHEETS Then
    
        Dim vSheetNames As Variant
        vSheetNames = swDraw.GetSheetNames
        
        Dim activeSheetName As String
        activeSheetName = swDraw.GetCurrentSheet().GetName
        
        Dim i As Integer
        
        For i = 0 To UBound(vSheetNames)
            Dim swSheet As SldWorks.sheet
            Set swSheet = swDraw.sheet(CStr(vSheetNames(i)))
            InsertBomTable swDraw, swSheet
        Next
        
        swDraw.ActivateSheet activeSheetName
        
    Else
        InsertBomTable swDraw, swDraw.GetCurrentSheet
    End If
    
End Sub

Sub InsertBomTable(draw As SldWorks.DrawingDoc, sheet As SldWorks.sheet)
    
    If False = draw.ActivateSheet(sheet.GetName()) Then
        Err.Raise vbError, "", "Failed to activate sheet " & sheet.GetName
    End If
    
    Dim vViews As Variant
    vViews = sheet.GetViews
    
    Dim swView As SldWorks.View
    
    Set swView = vViews(0)
    
    Dim swBomTableAnn As SldWorks.BomTableAnnotation
    
    Set swBomTableAnn = swView.InsertBomTable4(True, 0, 0, ANCHOR_TYPE, BOM_TYPE, "", TABLE_TEMPLATE, False, INDENTED_NUMBERING_TYPE, DETAILED_CUT_LIST)
        
    If Not swBomTableAnn Is Nothing Then
        swBomTableAnn.BomFeature.FollowAssemblyOrder2 = FOLLOW_ASSEMBLY_ORDER
    Else
        Err.Raise vbError, "", "Failed to insert BOM table into " & swView.Name
    End If
    
End Sub

Um genauer auf Ihrem Makro zu antworten, muss der Test für die Existenz einer Ansicht in der Zeichnung durchgeführt werden:

swView = swView.GetNextView

und nicht auf:

Set swView = swDraw.GetFirstView
3

@+1 für @Maclane
Die erste Ansicht ist die Hintergrundkarte, daher ist NextView Pflicht!

1 „Gefällt mir“