Witam
Ten temat jest kontynuacją 2 innych postów na ten sam temat:
- - https://www.lynkoa.com/forum/solidworks/export-nomenclature-vers-excel-avec-une-macro-vba
- - https://www.lynkoa.com/forum/import-de-donn%C3%A9es-num%C3%A9ris%C3%A9es/export-nomenclature-vers-excel
To makro działa dobrze i za to dziękuję. Mam jednak dwie małe uwagi:
- nie bierze pod uwagę, czy części są zdefiniowane jako "Wykluczone z BOM". Wszystkie dokumenty wyróżniają się w tabeli Excel.
- W przypadku części spawanych mechanicznie makro eksportuje każdy spawany korpus jako samodzielną część, podczas gdy te obiekty powinny być wyłączone z nomenklatury (cóż, w moim przypadku).
Czy możliwe jest rozwiązanie tych 2 małych problemów za pomocą dodatkowego fragmentu kodu?
Jeśli nie można ich ukryć, być może możliwe jest dodanie kolumny do pliku Excel z właściwością "Wykluczone z BOM" i jako wartość w każdym wierszu TAK lub NIE.
Dziękuję za pomoc
Miłego dnia
Witam
Nie wiem od jakiego dokładnie makra zacząłeś i jakich modyfikacji dokonałeś, ale i tak dziwne jest, że części wyłączone z nomenklatury pojawiają się w tej nomenklaturze (chyba że są wyłączone z nomenklatury w konfiguracji, ale nie w tej, z której bierzesz nomenklaturę).
W przypadku części spawanych mechanicznie jest to prawdopodobnie spowodowane typem swBom wybranym do tworzenia zestawienia komponentów:
- "Wcięte": wszystkie poziomy, łącznie z profilami spawanymi mechanicznie.
- "TopLevelOnly": tylko pierwszy poziom, a nie profile spawane mechanicznie.
Pod tym linkiem wydaje mi się, że wszystkie przydatne informacje.
Pozdrowienia
1 polubienie
Witam
Dziękuję za odpowiedź. Tak, widziałem temat dyskusji, o którym wspominasz.
Jeśli zmienię swBomType na "TopLevelOnly", w rzeczywistości mam tylko 1. poziom, więc brakuje mi wszystkich podpoziomów.
Jeśli umieszczę swBomType w "Indented", to schodzi on do korpusu części spawanych mechanicznie, co jest zbyt niską podłogą.
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
Jak zatem możemy to zrobić?
Dziękujemy za Twoją opinię,
Pozdrowienia
Witam
W takim przypadku możliwe jest ustawienie swBomType na "Wcięcie" i pobranie komponentu dla każdego wiersza BOM za pomocą funkcji Getcomponents2 , aby zdecydować, czy wstawić go do pliku Excel, może być konieczne zawieszenie się na obiekcie ModelDoc2 dla każdego komponentu, aby go przeanalizować, można to zrobić za pomocą funkcji GetModelDoc2.
Pozdrowienia
Wow, dojdziemy do granic moich umiejętności programistycznych.
Mam wrażenie, że wszystko sprowadza się do linijki "Set swBOMAnnotation = swModelDocExt.InsertBomTable3... ", w którym nomenklatura jest tworzona. Już tutaj pojawiają się korpusy spawanej części. W załączeniu dokument, o którym mowa.
Od SW, ręcznie zmieniając parametry nomenklatury, nie mogę tych ciał ukryć. Nawet odznaczenie pola "Szczegółowa lista spawanych części" nie pomaga.
Co robić w takim przypadku?
Dziękuję za pomoc
test.zip
Witam
Oto możliwe rozwiązanie, zacząłem od makra, które już zrobiłem, więc ma być ponownie dostosowane do Twojego przypadku, ale zasada jest następująca: dla każdej linii nomenklatury dostaję ModelDoc do analizy i sprawdzenia, czy jest to konstrukcja spawana, jeśli tak jest i że ten ModelDoc2 jest taki sam jak poprzednia linia, to nie muszę się o to martwić. nie uwzględnia tego przy eksporcie do programu Excel.
Zrobiłem swoje testy na jednym z moich zespołów, ponieważ nie mogę otworzyć uchwytu (przyszła wersja).
Pozdrowienia
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
Dzień dobry panu
Dziękuję za poświęcenie czasu na przyjrzenie się mojemu problemowi. Zmodyfikowałem więc moje makro zgodnie z Twoimi zaleceniami.
Jeśli dobrze rozumiem, makro przechodzi przez wszystkie linie konstrukcyjne części i sprawdza, czy znajduje tekst "konstrukcja spawana".
Wszystko dzieje się w tej pętli:
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
Zastosowana do mojej części, pętla przechodzi przez funkcje, ale nie przez "Listę spawanych części".
Dodałem swfeat Debug.Print. Nazwa, aby zobaczyć, co wyjdzie:
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
w porównaniu ze strukturą drzewa w moim pokoju (patrz załącznik).
Jeszcze raz dziękuję za pomoc
Miłego dnia
arbre_piece.png
Dziwne, oto co mam w debug.print:
w porównaniu z częścią w SW:
Widać, że zaczynałem od konstrukcji spawanej w konstrukcji mojego kawałka... szkoda, że nie mogę otworzyć wcześniej dołączonego...
Pozdrowienia
Rzeczywiście, to dziwne.
Czy masz zaznaczoną funkcję automatycznej aktualizacji?
Czy to może pochodzić stamtąd?
Dziękujemy za próbę
Ale zaskakujące jest to, że debug.print nie wyświetla wszystkiego w drzewie tworzenia, część jest ładowana w trybie rozwiązanym?
Tak, gra jest dobrze rozdzielczo
A jak to wygląda z montażem i załącznikami?
insert-bom-asm.zip
Właśnie ponownie przetestowałem, po prostu zobaczyłem
Boss.-Extru.3
Dégagement M81
Diamètre du perçage Ø12.0 (12)1
Article-liste-des-pièces-soudées1
Article-liste-des-pièces-soudées2
Article-liste-des-pièces-soudées3
Esquisse29
Esquisse2
Lista artykułów... w samym środku reszty drzewa w pokoju. To dziwne.
No cóż, powinienem się z tego wydostać sprawdzając, czy mam słowo "spawany" w swfeat. Nazwa.
Jedyny problem z tą metodą polega na tym, że trzeba uważać, aby nie zmienić nazw spawanych obiektów.
Oto zmodyfikowany fragment kodu, jeśli ktoś kiedykolwiek go będzie potrzebował
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
Dziękuję d.roger
Nie wiem, jak wygląda twój solidworks, ale prawie musi wykonać projekt samodzielnie, po prostu klikając na makro :-D
Uważaj, od czasu do czasu musisz zamknąć edytor makr i ponownie go otworzyć (nie zapominając o uprzednim zapisaniu makra), zauważyłem, że po pewnym czasie użytkowania ma trochę problemów z odświeżeniem, może też pochodzić stamtąd ...
W moim makrze szukam funkcji "Konstrukcja spawana", która nie zmienia się nawet przy zmianie nazw spawanych obiektów:
Jeśli chodzi o mój SW, nie, nie robi projektu sam, klikając na makro, chociaż w przypadku niektórych części nie jest od niego bardzo daleko :-)
Będziesz musiał pomyśleć o zweryfikowaniu najlepszej odpowiedzi, jeśli istnieje taka, która spełnia żądanie, może to pomóc innym użytkownikom, którzy prawdopodobnie będą mieli ten sam typ żądania ...
Pozdrowienia
I tak dla zabawy, filmik jest słabej jakości, ale pokazuje, jak SW może narysować koło zębate przez ewolwentację koła prawie sam :-)
usinage_pignon.mp4