Deze macro werkt goed en ik dank u daarvoor. Ik heb echter twee kleine opmerkingen:
er wordt geen rekening gehouden met het feit of onderdelen al dan niet worden gedefinieerd als "Uitgesloten van de stuklijst". Alle documenten vallen op in de Excel-tabel.
Voor mechanisch gelaste onderdelen exporteert de macro elk gelast lichaam als een op zichzelf staand onderdeel, terwijl deze lichamen van de nomenclatuur zouden moeten worden uitgesloten (nou ja, in mijn geval).
Is het mogelijk om deze 2 kleine problemen op te lossen door een extra stukje code?
Als het niet mogelijk is om ze te verbergen, is het misschien mogelijk om een kolom aan het Excel-bestand toe te voegen met een eigenschap "Uitgesloten van stuklijst" en als een waarde op elke JA- of NO-rij.
Ik weet niet met welke macro je precies bent begonnen en welke wijzigingen je hebt aangebracht, maar het is nog steeds raar dat delen die zijn uitgesloten van de nomenclatuur in deze genoemde nomenclatuur voorkomen (tenzij ze zijn uitgesloten van de nomenclatuur in een configuratie, maar niet in degene waarvan je de nomenclatuur krijgt).
Voor mechanisch gelaste onderdelen is dit waarschijnlijk te wijten aan het swBomType dat is gekozen voor het maken van de BOM:
- "Ingesprongen": alle niveaus, inclusief de profielen van de mechanisch gelaste.
- "TopLevelOnly": alleen het eerste niveau dus niet de profielen van het mechanisch gelaste.
Dank u voor uw antwoord. Ja, ik had het gespreksonderwerp gezien dat je noemt. Als ik het swBomType verander in "TopLevelOnly", heb ik eigenlijk alleen het 1e niveau, dus ik mis alle subniveaus. Als ik de swBomType in "Ingesprongen" zet, gaat het naar de body van de mechanisch gelaste onderdelen, wat een te lage vloer is.
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
Hoe kunnen we dat dan doen? Bedankt voor je feedback,
In dit geval is het mogelijk om swBomType in te stellen op "Ingesprongen" en de component voor elke rij van de BOM op te halen met behulp van de functie Getcomponents2 om te beslissen of deze al dan niet in het Excel-bestand moet worden ingevoegd, het kan zijn dat u het ModelDoc2-object voor elke component moet vasthouden om deze te analyseren, dit kan worden gedaan met behulp van de functie GetModelDoc2.
Wauw, we gaan de grenzen van mijn programmeervaardigheden bereiken.
Ik heb de indruk dat alles neerkomt op de regel "Set swBOMAnnotation = swModelDocExt.InsertBomTable3... " waar de nomenclatuur wordt gemaakt. Hier verschijnen al de lichamen van het gelaste deel. Bijgevoegd, het document in kwestie. Sinds SW, door handmatig de parameters van de nomenclatuur te wijzigen, kan ik deze lichamen niet verbergen. Zelfs het uitvinken van het vakje "Gedetailleerde lijst van gelaste onderdelen" helpt niet. Wat moet ik in dit geval doen?
Hier is een mogelijke oplossing, ik ben uitgegaan van de macro die ik al had gemaakt, dus het moet opnieuw worden aangepast aan uw geval, maar het principe is: voor elke regel van de nomenclatuur laat ik de ModelDoc deze analyseren en kijken of het een gelaste constructie is, als dat het geval is en dat deze ModelDoc2 hetzelfde is als de vorige regel, dan hoef ik me er geen zorgen over te maken. houdt hier geen rekening mee voor de export naar Excel. Ik heb mijn tests gedaan op een van mijn assemblages omdat ik de houder (toekomstige versie) niet kan openen.
Vriendelijke groeten
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
Bedankt dat je de tijd hebt genomen om naar mijn probleem te kijken. Dus ik heb mijn macro aangepast met uw aanbevelingen. Als ik het goed begrijp, gaat de macro door alle constructieregels van het onderdeel en controleert of er een tekst "gelaste constructie" wordt gevonden. Alles gebeurt in deze lus:
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
Toegepast op mijn onderdeel, gaat de lus over de functies, maar niet over "Lijst van gelaste onderdelen". Ik heb een Debug.Print swfeat. Naam om te zien wat eruit komt:
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
vergeleken met de boomstructuur van mijn kamer (zie bijlage).
Artikel-lijst... precies in het midden van de rest van de boom in de kamer. Dat is raar. Nou, het zou me moeten lukken om eruit te komen door te kijken of ik het woord "gelast" in de swfeat. Naam. Het enige probleem met deze methode is dat je moet oppassen dat je de gelaste lichamen niet hernoemt.
Hier is het gewijzigde stukje code als iemand het ooit nodig heeft
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
Dank je wel d.roger
Ik weet niet hoe je solidworks eruit ziet, maar het moet bijna het ontwerp zelf doen door gewoon op een macro-:-D te klikken
Wees voorzichtig, van tijd tot tijd moet je de macro-editor sluiten en opnieuw openen (zonder te vergeten eerst je macro op te slaan), ik merkte dat het na een tijdje gebruik een beetje moeite heeft om op te frissen, het kan ook daar vandaan komen ...
In mijn macro zoek ik naar de functie "Gelaste constructie" die niet verandert, zelfs niet bij het hernoemen van de gelaste lichamen:
Wat betreft mijn SW, nee, het doet het ontwerp niet zelf door op een macro te klikken, hoewel het voor sommige delen niet ver weg is :-)
U zult moeten nadenken over het valideren van het beste antwoord als er een is die aan het verzoek voldoet, het kan andere gebruikers helpen die waarschijnlijk hetzelfde type verzoek hebben ...
En gewoon voor de lol, de video is van slechte kwaliteit, maar het laat zien hoe SW bijna zelf een rondsel kan tekenen door de kronkel van een cirkel te draaien :-)
