Stücklistenextraktionsmakro in detaillierter Tabellierung ohne Schweißteile

Aritech · 6. Juni 2023 um 08:17

Hallo

Ich habe ein Makro, das hervorragend funktioniert, um eine Excel-Datei meiner Stücklisten zu generieren, aber ich kann geschweißte Teile nicht ausschließen, die ich nie in einer allgemeinen Stückliste der gesamten Maschine verarbeite.
Meine Nomenklatur ist im Plan korrekt, aber nicht im Export.

Capture

Ich verstehe, dass der letzte Begriff " Falsch " sein sollte, aber...

Stücklistentyp = swBomType_Indented
Configuration = " Standard" ‹ Name der eingestellten Konfiguration ›
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(Vorlagenname, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 Wahr

Was ist zu tun?

sbadenis · 6. Juni 2023 um 08:50

Der angegebene Code scheint mir gut zu sein. Tatsächlich ist es das letzte False, um die detaillierte Liste zu aktivieren oder zu deaktivieren.
Können Sie den Rest des Codes anhängen, um zu sehen, ob der Fehler nicht vom Rest kommt?
Außerdem ist es einfacher, den Code zu lesen, wenn er mit den richtigen Tags eingefügt wird.
Klicken Sie dazu hier:

Puis tu remplaces le texte ici par ton code

Aritech · 6. Juni 2023 um 09:53



Sub main()

Dim xlApp As Object
Dim wbk As Object 'not Workbook
Dim sht As Object 'not Worksheet
'si nécessaire : Dim rng As Object 'not Range'

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
If swModel Is Nothing Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test l'activité du document
    Exit Sub
ElseIf swModel.GetType <> swDocASSEMBLY Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test que le fichier est un assemblage
    Exit Sub
ElseIf swModel.GetPathName = "" Then
    swApp.SendMsgToUser2 ("Assemblage non enregistré."), swMbWarning, swMbOk 'test que l'assemblage est enregistré
    Exit Sub
End If
Set swModelDocExt = swModel.Extension

Set xlApp = CreateObject("Excel.Application")
Set wbk = xlApp.Workbooks.Open("(.......)Nomenclature.xls") ' ouverture du modèle 'ou création d'un nouveau: Set wbk = xlApp.Workbooks.Add
'si nécessaire : Sélection feuille existante: Set sht = wbk.Worksheets(1)': ajout d'une feuille de calculSet wks = wbk.Sheets.Add'
'si nécessaire : Sélection d'une cellule : Set rng = thisWs.Range("A11")'

TemplateName = "(...)\Nomenclatures\Détaillée.sldbomtbt" 'création de la nomenclature automatique solidworks suivant modèle'
BomType = swBomType_Indented
Configuration = "Défaut" 'nom de la configuration de l'ensemble'
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

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

For I = 0 To NumRow
    For J = 0 To NumCol
      wbk.Sheets("Nomenclature").Cells(I + 9, J + 1) = swBOMAnnotation.Text(I + 1, J) 'écriture des données de nomenclature'
    Next J
Next I

boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

swModel.ForceRebuild3 True

Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim NomProperty1 As String
Dim NomProperty2 As String
Dim NomProperty3 As String
Dim NomProperty4 As String
Dim NomProperty5 As String
Dim NomProperty6 As String
Dim NomProperty7 As String
Dim DateStr As Date

Set config = swModel.GetActiveConfiguration ': pointe vers les propriétés solidworks du document actif
'Set cusPropMgr = config.CustomPropertyManager' : récupération des propriétés spécifiques à la configuration (Solidworks > propriétés> spécifiques à la config.
Set cusPropMgr = swModelDocExt.CustomPropertyManager("") 'récupération des propriétés personnalisées

nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
    cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
    custPropType = cusPropMgr.GetType2(vPropNames(K))
        If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'
        NomProperty1 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1
    End If
    If vPropNames(K) = "N° Plan / Réf / Dim" Then
        NomProperty2 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2
    End If
    If vPropNames(K) = "Nom de projet" Then
        NomProperty3 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3
    End If
    If vPropNames(K) = "Désignation" Then
        NomProperty4 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4
    End If
    If vPropNames(K) = "Dessinateur" Then
        NomProperty5 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(2, 7) = "   Dessinateur :   " & NomProperty5
    End If
    If vPropNames(K) = "Vérificateur" Then
        NomProperty6 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 7) = "   Vérificateur :   " & NomProperty6
    End If
    If vPropNames(K) = "Indice en cours" Then
        NomProperty7 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(4, 7) = "   Indice en cours :   " & NomProperty7
    End If
Next K

wbk.Sheets("Nomenclature").Cells(1, 6) = "   Date:   " & DateValue(Now) 'extraction date du système

Dim chemin As String
chemin = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & NomProperty7 & " -Détaillée " & ".xls"  'renseignement du chemin et du nom d'enregistrement '& NomProperty : ajout d'une propriété personnalisée au nom de fichier

With xlApp
    .DisplayAlerts = False
    .EnableEvents = False
    wbk.SaveAs chemin  'enregistre le fichier et écrase si fichier déjà existant
    .DisplayAlerts = True
    .EnableEvents = True
    wbk.Close  'ferme le workbook
    .Quit  'quitte excel
End With

swApp.SendMsgToUser2 ("Nomenclature de l'ensemble de la machine créée."), swMbInformation, swMbOk 'msgbox solidworks

End Sub

Lynkoa15 · 6. Juni 2023 um 19:15

Hallo @tous
Von meiner Seite aus sind die Nomenklatur und der Export korrekt,
@Aritech, Sie haben gesagt, dass Ihre Nomenklatur korrekt ist, aber der Exportteil kopiert nur die Zellen! , hat die Nomenklatur diese Art der Gruppierung von Körpern nicht zufällig?

Aritech · 7. Juni 2023 um 07:11

Hallo, vielen Dank für Ihr Feedback.

Ich habe diese Art der Gruppierung.

Es funktioniert in SW, aber nicht im Export. Es geht sogar noch weiter. Für den Export habe ich sogar das ungefaltete gefaltete Blech, das eine Rettungsleine hinzufügt, die für mich unbrauchbar ist.
Wenn ich verstehe, was ich im geteilten Thread gelesen habe, dann, dass es sich um einen Fehler handelt, der im SW2022 behoben wurde

Lynkoa15 · 7. Juni 2023 um 07:28

In diesem Fall schlage ich vor, die Unterregisterkarten zu überprüfen und sie beim Export zu ignorieren
Eine Teile-Unterregisterkarte kann nur ein Körper sein

Aritech · 7. Juni 2023 um 07:48

Aber ist es konkret mein Makro, das geändert werden muss, oder ist es eine Eigenschaft, die in SW geändert werden muss?

Lynkoa15 · 7. Juni 2023 um 13:39

Angehängt sind zwei Methoden, die erste basiert auf der Eigenschaft "partNumber", wenn letztere nicht für die Schweißkonstruktion definiert ist, die zweite basiert auf Tabulatoren

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
Dim row As Long
row = 0
For i = 0 To NumRow
    Dim itemNum As String, partnum As String
    swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
    If isValidPart2(partnum) = False Then GoTo next_i
	For J = 0 To NumCol
            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
        Next J
        row = row + 1
next_i:
Next i

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
Dim partTab As String
Dim row As Long
row = 0
For i = 0 To NumRow
    If swBOMAnnotation.Text(i + 1, 0) = "" Then GoTo next_i
    Dim comp As Component2
    Set comp = swBOMAnnotation.GetComponents2(i + 1, "")(0)
    If isValidPart(comp, swBOMAnnotation.Text(i + 1, 0), partTab) = True Then
        For J = 0 To NumCol
            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
        Next J
        row = row + 1
    End If
next_i:
Next i

Function isValidPart(comp As Component2, tabulation As String, ByRef partTab As String) As Boolean
    isValidPart = True
    Dim ext As String
    ext = comp.GetPathName()
    ext = Right(ext, Len(ext) - InStrRev(ext, ".", -1, vbTextCompare))
    If ext = "SLDPRT" Then
        Dim tabNum As String
        If InStrRev(tabulation, ".", -1, vbTextCompare) <> 0 Then
            tabNum = Left(tabulation, InStrRev(tabulation, ".", -1, vbTextCompare) - 1)
        Else: tabNum = tabulation
        End If
        If tabNum = partTab Then
            isValidPart = False
        Else
            partTab = tabulation
        End If
    End If
End Function

Function isValidPart2(str As String) As Boolean
    isValidPart2 = false
    If str = "" Then Exit Function
    Dim i As Long
    For i = 1 To Len(str)
        If Mid(str, i, 1) <> " " Then
            isValidPart2 = true
            Exit Function
        End If
    Next i
End Function

Aritech · 8. Juni 2023 um 06:07

Hallo

Ich bin überhaupt kein Experte im Programmieren. An diesem Makro herumgebastelt zu haben, um eine Excel-Tabelle zu erstellen, die gut funktioniert, war für mich schon eine Art Meisterleistung... Aber hier bleibe ich völlig stehen, um alle Feinheiten zu verstehen.
Ich bin mir überhaupt nicht sicher, wo und wie ich diese Codes in mein Makro integrieren soll.

Ich habe den vorgeschlagenen Code in mein Makro (erste Methode) eingefügt und hier ist er:

sbadenis · 8. Juni 2023 um 06:11

Sie müssen den gesamten Code vollständig einfügen, um ihn besser zu verstehen, aber hier finde ich wohl nicht die isValidPart-Funktion (3. Fenster), die in Ihrem Code aufgerufen wird, daher das sub oder
Funktion nicht definiert.

Fügen Sie die IsvalidPart-Funktion in das gleiche Modul nach dem Endsub ein, und das sollte zumindest dieses Problem lösen.

Lynkoa15 · 8. Juni 2023 um 15:23

Tatsächlich fehlten nach der letzten Zeile des Codes nur die 2 Funktionen

Aritech · 9. Juni 2023 um 06:06

Hallo
Vielen Dank für die Zeit, die Sie aufgewendet haben, um mein Problem zu lösen. Aber ich zögere immer noch.
Ich habe meinen vollständigen Code an den Anfang der Diskussion gestellt. Ich habe nicht die Sprache, ich bastle nur an all dem herum^^'

Lynkoa15 · 9. Juni 2023 um 07:24

Hallo @Aritech
Unten ist der Code

Sub main()

Dim xlApp As Object
Dim wbk As Object 'not Workbook
Dim sht As Object 'not Worksheet
'si nécessaire : Dim rng As Object 'not Range'

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
If swModel Is Nothing Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test l'activité du document
    Exit Sub
ElseIf swModel.GetType <> swDocASSEMBLY Then
    swApp.SendMsgToUser2 ("Aucun assemblage actif détecté."), swMbWarning, swMbOk 'test que le fichier est un assemblage
    Exit Sub
ElseIf swModel.GetPathName = "" Then
    swApp.SendMsgToUser2 ("Assemblage non enregistré."), swMbWarning, swMbOk 'test que l'assemblage est enregistré
    Exit Sub
End If
Set swModelDocExt = swModel.Extension

Set xlApp = CreateObject("Excel.Application")
Set wbk = xlApp.Workbooks.Open("..... Nomenclature.xlsx") ' ouverture du modèle 'ou création d'un nouveau: Set wbk = xlApp.Workbooks.Add
'si nécessaire : Sélection feuille existante: Set sht = wbk.Worksheets(1)': ajout d'une feuille de calculSet wks = wbk.Sheets.Add'
'si nécessaire : Sélection d'une cellule : Set rng = thisWs.Range("A11")'

TemplateName = "...... Détaillée.sldbomtbt" 'création de la nomenclature automatique solidworks suivant modèle'
BomType = swBomType_Indented
Configuration = "Défaut" 'nom de la configuration de l'ensemble'
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
'''''''''''''''''''''''''''''''''''''''''''''   methode 1 '''''''''''''''''''''''''''''''''''''''''''''''''''''''
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
Dim row As Long
row = 0
For i = 0 To NumRow
    Dim itemNum As String, partnum As String
    swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
    If isValidPart2(partnum) = False Then GoTo next_i
        For J = 0 To NumCol
            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
        Next J
        row = row + 1
next_i:
Next i
''''''''''''''''''''''''''''''''''''''''''''''   methode 2 ''''''''''''''''''''''''''''''''''''''''''''''''''''''
'NumCol = swBOMAnnotation.ColumnCount
'NumRow = swBOMAnnotation.RowCount
'Dim partTab As String
'Dim row As Long
'row = 0
'For i = 0 To NumRow
'    If swBOMAnnotation.Text(i + 1, 0) = "" Then GoTo next_i
'    Dim comp As Component2
'    Set comp = swBOMAnnotation.GetComponents2(i + 1, "")(0)
'    If isValidPart(comp, swBOMAnnotation.Text(i + 1, 0), partTab) = True Then
'        For J = 0 To NumCol
'            wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
'        Next J
'        row = row + 1
'    End If
'next_i:
'Next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

swModel.ForceRebuild3 True

Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim NomProperty1 As String
Dim NomProperty2 As String
Dim NomProperty3 As String
Dim NomProperty4 As String
Dim NomProperty5 As String
Dim NomProperty6 As String
Dim NomProperty7 As String
Dim DateStr As Date

Set config = swModel.GetActiveConfiguration ': pointe vers les propriétés solidworks du document actif
'Set cusPropMgr = config.CustomPropertyManager' : récupération des propriétés spécifiques à la configuration (Solidworks > propriétés> spécifiques à la config.
Set cusPropMgr = swModelDocExt.CustomPropertyManager("") 'récupération des propriétés personnalisées

nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
    cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
    custPropType = cusPropMgr.GetType2(vPropNames(K))
        If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'
        NomProperty1 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1
    End If
    If vPropNames(K) = "N° Plan / Réf / Dim" Then
        NomProperty2 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2
    End If
    If vPropNames(K) = "Nom de projet" Then
        NomProperty3 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3
    End If
    If vPropNames(K) = "Désignation" Then
        NomProperty4 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4
    End If
    If vPropNames(K) = "Dessinateur" Then
        NomProperty5 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(2, 7) = "   Dessinateur :   " & NomProperty5
    End If
    If vPropNames(K) = "Vérificateur" Then
        NomProperty6 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(3, 7) = "   Vérificateur :   " & NomProperty6
    End If
    If vPropNames(K) = "Indice en cours" Then
        NomProperty7 = ResolvedValOut
        wbk.Sheets("Nomenclature").Cells(4, 7) = "   Indice en cours :   " & NomProperty7
    End If
Next K

wbk.Sheets("Nomenclature").Cells(1, 6) = "   Date:   " & DateValue(Now) 'extraction date du système

Dim chemin As String
chemin = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & NomProperty7 & " -Détaillée " & ".xlsx"  'renseignement du chemin et du nom d'enregistrement '& NomProperty : ajout d'une propriété personnalisée au nom de fichier

With xlApp
    .DisplayAlerts = False
    .EnableEvents = False
    wbk.SaveAs chemin  'enregistre le fichier et écrase si fichier déjà existant
    .DisplayAlerts = True
    .EnableEvents = True
    wbk.Close  'ferme le workbook
    .Quit  'quitte excel
End With

swApp.SendMsgToUser2 ("Nomenclature de l'ensemble de la machine créée."), swMbInformation, swMbOk 'msgbox solidworks

End Sub

Function isValidPart(comp As Component2, tabulation As String, ByRef partTab As String) As Boolean
    isValidPart = True
    Dim ext As String
    ext = comp.GetPathName()
    ext = Right(ext, Len(ext) - InStrRev(ext, ".", -1, vbTextCompare))
    If ext = "SLDPRT" Then
        Dim tabNum As String
        If InStrRev(tabulation, ".", -1, vbTextCompare) <> 0 Then
            tabNum = Left(tabulation, InStrRev(tabulation, ".", -1, vbTextCompare) - 1)
        Else: tabNum = tabulation
        End If
        If tabNum = partTab Then
            isValidPart = False
        Else
            partTab = tabulation
        End If
    End If
End Function

Function isValidPart2(str As String) As Boolean
    isValidPart2 = False
    If str = "" Then Exit Function
    Dim i As Long
    For i = 1 To Len(str)
        If Mid(str, i, 1) <> " " Then
            isValidPart2 = True
            Exit Function
        End If
    Next i
End Function

Aritech · 9. Juni 2023 um 09:24

Ich habe jetzt diesen Fehler!

Sub main()

xlApp als Objekt dimmen

Dim wbk As Object 'not Workbook

Dim sht As Object 'not Worksheet

'falls erforderlich: Dim rng As Object ‹ nicht Range ›

Dim swApp als SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim swBOMFeature As SldWorks.BomFeature
Dim boolstatus als boolescher Wert
BomType so lange dimmen
Konfiguration als Zeichenfolge dimmen
Dim TemplateName als Zeichenfolge

Legen Sie swApp = Application.SldWorks fest
Festlegen von swModel = swApp.ActiveDoc
Wenn swModel nichts ist, dann
swApp.SendMsgToUser2 (' Keine aktive Assembly erkannt. '), swMbWarning, swMbOk' Aktivität des Testdokuments
Sub beenden
ElseIf swModel.GetType <> swDocASSEMBLY dann
swApp.SendMsgToUser2 (' Keine aktive Assembly erkannt. '), swMbWarning, swMbOk' testet, ob es sich bei der Datei um eine Assembly handelt
Sub beenden
ElseIf swModel.GetPathName = " " dann
swApp.SendMsgToUser2 ( 'Nicht registrierte Assembly. '), swMbWarning, swMbOk' testen, ob die Assembly registriert ist
Sub beenden
Ende, wenn

Legen Sie swModelDocExt = swModel.Extension fest

Set xlApp = CreateObject(" Excel.Anwendung ")
Set wbk = xlApp.Workbooks.Open(" ... Nomenclature.xls") ' Öffnen der Vorlage ‹ oder Erstellen einer neuen: Set wbk = xlApp.Workbooks.Add
‹ bei Bedarf: Vorhandene Blattauswahl: Setze sht = wbk. Arbeitsblätter(1) ›: eine Tabelle hinzugefügtSet wks = wbk. Blätter.Hinzufügen ›
‹ falls nötig: Zelle auswählen: Set rng = thisWs.Range(" A11 ") ›

Vorlagenname = " ... Detailed.sldbomtbt » ‹ Erstellen der automatischen Stückliste von Solidworks nach Modell ›
Stücklistentyp = swBomType_Indented
Configuration = " Standard" ‹ Name der eingestellten Konfiguration ›
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(Vorlagenname, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, False)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 Wahr

NumCol so lange dimmen
Dim NumRow so lange
Sonne i So lang
Sun J So Lang
NumCol = swBOMAnnotation.ColumnCount
AnzahlZeile = swBOMAnnotation.ZeilenAnzahl

Dunkle Zeile So lang

Zeile = 0

Für i = 0 bis NumRow

Dim itemNum As String, partnum As String
swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
If isValidPart2(partnum) = False Then GoTo next_i
    For J = 0 To NumCol
        wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
    Next J
    row = row + 1

next_i:
Weiter i
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, " BOMFEATURE ", 0, 0, 0, Wahr, 0, Nichts, 0)
swModel.EditDelete
swModel.ForceRebuild3 Wahr

Dim-Konfiguration als SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal so lange
ValOut als String dimmen
Dim ResolvedValOut als Zeichenfolge
Dim wasResolved As Boolean
Dim nNbrProps so lange
Dim vPropNames als Variante
Dim vPropTypes als Variante
Dim vPropValues als Variante
Dimmen aufgelöst als Variante
Dim custPropType So lange
Dim K so lange
Dim PropertyName1 als Zeichenfolge
Dim PropertyName2 als Zeichenfolge
Dim PropertyName3 als Zeichenfolge
Dim PropertyName4 als Zeichenfolge
Dim PropertyName5 als Zeichenfolge
Dim PropertyName6 als Zeichenfolge
Dim PropertyName7 als Zeichenfolge
Dim DateStr As Date

Set config = swModel.GetActiveConfiguration ': verweist auf die Solidworks-Eigenschaften des aktuellen Dokuments
‹ Legen Sie cusPropMgr = config fest. CustomPropertyManager ›: Abrufen konfigurationsspezifischer Eigenschaften (Solidworks >-Eigenschaften> konfigurationsspezifische Eigenschaften.
Set cusPropMgr = swModelDocExt.CustomPropertyManager(" ")
nNbrProps = cusPropMgr.Anzahl
vPropNames = cusPropMgr.GetNames
Für K = 0 bis nNbrProps - 1

cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut

custPropType = cusPropMgr.GetType2(vPropNames(K))

    If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'

    NomProperty1 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1

End If

If vPropNames(K) = "N° Plan / Réf / Dim" Then

    NomProperty2 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2

End If

If vPropNames(K) = "Nom de projet" Then

    NomProperty3 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3

End If

If vPropNames(K) = "Désignation" Then

    NomProperty4 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4

End If

If vPropNames(K) = "Dessinateur" Then

    NomProperty5 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(2, 7) = "   Dessinateur :   " & NomProperty5

End If

If vPropNames(K) = "Vérificateur" Then

    NomProperty6 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(3, 7) = "   Vérificateur :   " & NomProperty6

End If

If vPropNames(K) = "Indice en cours" Then

    NomProperty7 = ResolvedValOut

    wbk.Sheets("Nomenclature").Cells(4, 7) = "   Indice en cours :   " & NomProperty7

End If

Weiter K

WBK. Sheets(" Nomenklatur "). cells(1, 6) = " Datum: " & DateValue(Jetzt)

Pfad als Zeichenfolge dimmen

path = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & " - " & PropertyName7 & " -Detailed " & " .xlsx " ' Geben Sie den Pfad und den Datensatznamen ein ' & PropertyName: Dem Dateinamen wurde eine benutzerdefinierte Eigenschaft hinzugefügt.

Mit xlApp

.DisplayAlerts = False

.EnableEvents = False

wbk.SaveAs chemin  'enregistre le fichier et écrase si fichier déjà existant

.DisplayAlerts = True

.EnableEvents = True

wbk.Close  'ferme le workbook

.Quit  'quitte excel

Enden mit

swApp.SendMsgToUser2 (" Stückliste der gesamten erstellten Maschine. "), swMbInformation, swMbOk 'msgbox solidworks

Ende Sub

Funktion isValidPart2(str As String) Als Boolean

isValidPart2 = False

If str = "" Then Exit Function

Dim i As Long

For i = 1 To Len(str)

    If Mid(str, i, 1) <> " " Then

        isValidPart2 = True

        Exit Function

    End If

Next i

Ende-Funktion

sbadenis · 9. Juni 2023 um 09:39

Im Allgemeinen bedeutet dies, dass Sie 2 mal die gleiche Deklaration haben, d.h. 2 mal die gleiche Zeile mit
Variable Dimmung
Ich vermute, Sie haben Ihren Code nicht gelöscht, bevor Sie das Kopieren und Einfügen durchgeführt haben, da ich nicht das gleiche Problem mit dem @Lynkoa15 Code habe.

Lynkoa15 · 9. Juni 2023 um 09:45

Wenn Sie das ausgeführt haben, haben Sie vergessen, die Pfade zur Excel-Tabelle und zur Tabellenmodellnomenklatur anzugeben, und wie gesagt, überprüfen @sbadenis , ob keine doppelten Deklarationen vorhanden sind

Aritech · 9. Juni 2023 um 10:13

In der Tat geht es so.

Ich werde es mit meinen verschiedenen Fällen sehen, aber es gibt ein GROSSES DANKESCHÖN an Sie.

Schönes Wochenende.