Makro ekstrakcji zestawienia komponentów w szczegółowej tabeli bez spawanych części

Aritech · 6 Czerwiec 2023 08:17

Witam

Mam makro, które świetnie sprawdza się w generowaniu Excela moich zestawień materiałowych, ale nie mogę wykluczyć spawanych części, których nigdy nie przetwarzam, w ogólnym zestawieniu komponentów całej maszyny.
Moja nomenklatura jest poprawna w planie, ale nie w eksporcie.

Capture

Rozumiem, że ostatni termin powinien brzmieć " Fałsz ", ale...

BomType = swBomType_Indented
Konfiguracja = " Domyślnie" ‹ nazwa ustawionej konfiguracji ›
Ustaw swBOMAnnotation = swModelDocExt.InsertBomTable3(NazwaSzablonu, 0, 0, TypFormularza, Konfiguracja, Fałsz, swNumberingType_Detailed, Fałsz)
Ustaw swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 Prawda

Co robić?

sbadenis · 6 Czerwiec 2023 08:50

Podany kod wydaje mi się dobry. Rzeczywiście, jest to ostatni fałsz, który należy sprawdzić lub odznaczyć szczegółową listę.
Czy możesz dołączyć resztę kodu, aby sprawdzić, czy błąd nie pochodzi z reszty?
A także łatwiej jest odczytać kod, gdy jest on wstawiony z odpowiednimi tagami.
Aby to zrobić, kliknij tutaj:

Puis tu remplaces le texte ici par ton code

Aritech · 6 Czerwiec 2023 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 Czerwiec 2023 19:15

Witam @tous
Z mojej strony nomenklatura i eksport są poprawne,
@Aritech, powiedziałeś, że twoja nomenklatura jest poprawna, ale część eksportowa tylko kopiuje komórki! , w nomenklaturze przypadkiem nie ma tego typu grupowania ciał?

Aritech · 7 Czerwiec 2023 07:11

Witam, dziękuję za opinię.

Mam tego typu grupowanie.

działa w oprogramowaniu, ale nie w eksporcie. Idzie to nawet dalej. Na eksport mam nawet rozłożoną złożoną blachę, która dodaje koło ratunkowe, które jest dla mnie bezużyteczne.
Jeśli rozumiem to, co przeczytałem w udostępnionym wątku, to to, że jest to błąd naprawiony w SW2022

Lynkoa15 · 7 Czerwiec 2023 07:28

W takim przypadku proponuję sprawdzić podzakładki i zignorować je w eksporcie
Karta podrzędna części może być tylko bryłą

Aritech · 7 Czerwiec 2023 07:48

Ale konkretnie, czy to moje makro musi zostać zmodyfikowane, czy jest to właściwość do modyfikacji w oprogramowaniu?

Lynkoa15 · 7 Czerwiec 2023 13:39

Dołączone dwie metody, pierwsza jest oparta na właściwości "partNumber", jeśli druga nie jest zdefiniowana dla konstrukcji spawanej, druga jest oparta na zakładkach

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 Czerwiec 2023 06:07

Witam

W ogóle nie jestem ekspertem w programowaniu. Majstrowanie przy tym makrze, aby stworzyć dobrze działającą tabelę Excela, było już dla mnie rodzajem wyczynu... Ale tutaj całkowicie się zatrzymuję, aby zrozumieć wszystkie subtelności.
Wcale nie jestem pewien, gdzie i jak zintegrować te kody z moim makrem.

Umieściłem proponowany kod w moim makrze (pierwsza metoda) i oto on:

sbadenis · 8 Czerwiec 2023 06:11

Musisz umieścić cały kod w całości, aby lepiej zrozumieć, ale tutaj chyba nie znajduje funkcji isValidPart (3. okno) wywołanej w twoim kodzie, stąd sub lub
Funkcja nie została zdefiniowana.

Wklej funkcję IsvalidPart do tego samego modułu po końcowym sub i to powinno rozwiązać przynajmniej ten problem.

Lynkoa15 · 8 Czerwiec 2023 15:23

Rzeczywiście, po ostatnim wierszu kodu brakowało tylko 2 funkcji

Aritech · 9 Czerwiec 2023 06:06

Witam
Dziękuję za czas poświęcony na rozwiązanie mojego problemu. Ale wciąż gram na zwłokę.
Umieściłem mój kompletny kod na początku dyskusji. Nie mam języka, po prostu majstruję przy tym wszystkim^^'

Lynkoa15 · 9 Czerwiec 2023 07:24

Witam @Aritech
Poniżej znajduje się kod

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 Czerwiec 2023 09:24

Mam teraz ten błąd!

Sub main()

Dim xlApp As Object

Dim wbk As Object 'not Workbook

Dim sht As Object 'not Arkusz roboczy

'w razie potrzeby: Dim rng As Object ‹ not Range ›

Dim swApp jako 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 tak długo, jak długo
Przyciemnij konfigurację jako ciąg
Dim TemplateName As Ciąg

Ustaw swApp = Application.SldWorks
Ustaw swModel = swApp.ActiveDoc
Jeśli swModel jest niczym, to
swApp.SendMsgToUser2 (' Nie wykryto aktywnego zestawu. '), swMbWarning, swMbOk' aktywność dokumentu testowego
Wyjdź z subwoofera
ElseIf swModel.GetType <> swDocASSEMBLY Następnie
swApp.SendMsgToUser2 (' Nie wykryto aktywnego zestawu. '), swMbWarning, swMbOk' sprawdza, czy plik jest zestawem
Wyjdź z subwoofera
ElseIf swModel.GetPathName = " " Następnie
swApp.SendMsgToUser2 ( 'Niezarejestrowany zestaw. '), swMbWarning, swMbOk' testuje, czy zestaw jest zarejestrowany
Wyjdź z subwoofera
Zakończ jeżeli:

Ustaw swModelDocExt = swModel.Extension

Ustaw xlApp = CreateObject(" Excel.Application ")
Ustaw wbk = xlApp.Workbooks.Open(" ... Nomenclature.xls") ' otwierając szablon ‹ lub tworząc nowy: Ustaw wbk = xlApp.Workbooks.Add
‹ w razie potrzeby: Istniejący wybór arkuszy: Ustaw sht = wbk. Arkusze robocze(1) ›: dodano arkusz kalkulacyjnyUstaw wks = wbk. Arkusze.Dodaj ›
‹ w razie potrzeby: Zaznaczanie komórki: Ustaw rng = thisWs.Range(" A11 ") ›

TemplateName = " ... Detailed.sldbomtbt » ‹ Tworzenie automatycznego zestawienia materiałów Solidworks zgodnie z modelem ›
BomType = swBomType_Indented
Konfiguracja = " Domyślnie" ‹ nazwa ustawionej konfiguracji ›
Ustaw swBOMAnnotation = swModelDocExt.InsertBomTable3(NazwaSzablonu, 0, 0, Typ Bom, Konfiguracja, Fałsz, swNumberingType_Detailed, Fałsz)
Ustaw swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 Prawda

Dim NumCol tak długo
Dim NumRow tak długo
Słońce i tak długo
Słońce J Tak długo
LiczbaKolumn = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

Przyciemnij rząd tak długo

wiersz = 0

Dla i = 0 Do LiczbaWiersz

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:
Dalej i
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, " BOMFEATURE ", 0, 0, 0, Prawda, 0, Nic, 0)
swModel.EditDelete
swModel.ForceRebuild3 Prawda

Przyciemnij konfigurację jako SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal tak długo
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps tak długo
Dim vPropNames jako wariant
Dim vPropTypes jako wariant
Dim vPropValues jako wariant
Dim rozwiązany jako wariant
Dim custPropType As Long
Dim K tak długo
Dim PropertyName1 As Ciąg
Dim PropertyName2 As Ciąg
Dim PropertyName3 As Ciąg
Dim PropertyName4 As Ciąg
Dim PropertyName5 As Ciąg
Dim PropertyName6 As Ciąg
Dim PropertyName7 As Ciąg
Dim DateStr As Data

Set config = swModel.GetActiveConfiguration ': wskazuje na właściwości solidworks bieżącego dokumentu
‹ Ustaw cusPropMgr = config. CustomPropertyManager ›: Pobieranie właściwości specyficznych dla konfiguracji (właściwości Solidworks >> właściwości specyficzne dla konfiguracji.
Ustaw cusPropMgr = swModelDocExt.CustomPropertyManager(" ")
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
Dla K = 0 do 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

Następny k

WBK. Arkusze (" Nomenklatura "). Cells(1, 6) = " Data: " & DateValue(Now)

Przyciemnij ścieżkę jako ciąg

path = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & " - " & PropertyName7 & " -Detailed " & " .xlsx " ' Wypełnij ścieżkę i nazwę rekordu ' & PropertyName: Dodano niestandardową właściwość do nazwy pliku

Z 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

Zakończ się na

swApp.SendMsgToUser2 (" BOM całej utworzonej maszyny. "), swMbInformation, swMbOk 'msgbox solidworks

Koniec subwoofera

Funkcja 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

Zakończ funkcję

sbadenis · 9 Czerwiec 2023 09:39

Ogólnie oznacza to, że masz 2 razy tę samą deklarację, tj. 2 razy ten sam wiersz z
Zmienne przyciemnienie
Domyślam się, że nie usunąłeś swojego kodu przed wykonaniem kopiowania i wklejania, ponieważ nie mam tego samego problemu z kodem @Lynkoa15 .

Lynkoa15 · 9 Czerwiec 2023 09:45

Jeśli to jest to, co wykonałeś, zapomniałeś określić ścieżki do nomenklatury tabel i modeli tabel programu Excel, a jak wspomniano, @sbadenis sprawdzić, czy nie ma podwójnych deklaracji

Aritech · 9 Czerwiec 2023 10:13

Rzeczywiście, tak to wygląda.

Zobaczę z moimi różnymi przypadkami, ale tam WIELKIE PODZIĘKOWANIA dla ciebie.

Miłego weekendu.