Hoi allemaal
Het doel is om automatisch via een VBA-macro een naam in een assembly te maken en deze te exporteren naar een Excel-bestand waarvan de naam de naam van het onderdeelbestand + een aangepaste eigenschap zal zijn. Ten slotte moet de macro de gemaakte stuklijst verwijderen.
We hebben geen My Cad tools - Solidworks Prenium
Hallo
Het lijkt veel op een vacature lol
Ben je anders begonnen met het kijken naar de macrorecorder?
Vriendelijke groeten
Hallo
Heb je al een stukje code om ons te laten zien?
Dimitri.
Hallo
Kijk naar de bijgevoegde macro, normaal gesproken is alles aanwezig (een beetje los en zonder veiligheidscontroles). Verander in ieder geval de regels:
TemplateName = "Z:\Model_SW\Nomenclatuur.sldbomtbt"
Configuratie = "Standaard"
Als vPropNames(K) = "CARTOONIST" Dan
Als u het pad naar uw stuklijstsjabloon wilt plaatsen, moet u de naam van uw standaardconfiguratie in uw asms en de naam van uw aangepaste eigenschap in de bestandsnaam plaatsen.
Vriendelijke groeten
Dank u voor uw antwoord d.roger, de macro werkt, enige kleine probleem, toen ik de aangepaste eigenschap waar je me vertelde dat de waarde van de eigenschap niet wordt geretourneerd in de bestandsnaam. Ik heb de indruk dat de regel die de naam van het bestand in de macro maakt, er is geen herinnering aan de eigenschap, ik heb geprobeerd deze toe te voegen, maar de tests zijn aan deze kant niet overtuigend.
Hallo
Je moet de 2 regels vervangen:
Set config = swModel.GetActiveConfiguration
Stel cusPropMgr in = config. CustomPropertyManager
die de in de actieve configuratie gevraagde waarde ophalen door:
Stel cusPropMgr in = swModelDocExt.CustomPropertyManager("")
die de waarde in het tabblad "Aanpassen" zal ophalen
Vriendelijke groeten
Perfect door deze wijziging te maken, werkt de macro zoals ik wilde. Ter verbetering is het mogelijk om de spreadsheet in dezelfde map op te slaan als de assembly.
Hallo
Ja dat kan, je vervangt de lijn:
path = About("USERPROFILE") & "\Desktop\" & Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "-" & PropertyName & ".xlsx"
bij:
path = Links(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & PropertyName & ".xlsx"
Vriendelijke groeten
Hallo
Als je je Excel-bestand ook een beetje een lay-out wilt geven, kun je rijen toevoegen zoals bijvoorbeeld:
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
For I = 0 To NumRow - 1
For J = 0 To NumCol - 1
xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"
xlApp.ActiveSheet.Cells(I + 1, J + 1).VerticalAlignment = 2
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
In plaats van:
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
For I = 0 To NumRow
For J = 0 To NumCol
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
De lijn:
xlApp.ActiveSheet.Cells(I + 1, J + 1). NumberFormat = "@"
is vooral interessant als u numerieke waarden heeft die beginnen met 0, omdat het de Excel-cel in tekstformaat plaatst en zo voorkomt dat de 0 aan het begin verloren gaat.
Vriendelijke groeten
Hallo
Allereerst bedankt voor het delen, het is echt geweldig om hier informatie van deze kwaliteit te vinden!
Ik probeer de BOM-exportmacro in te stellen . Helaas krijg ik het niet aan de praat.
Ik krijg het bericht "Runtime error 91 Object variable or block variable with not defined" op de volgende regels:
Stel swBOMAnnotatie in = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuratie, False, swNumberingType_Detailed, True)
Stel swBOMFeature = swBOMAnnotation.BomFeature in
Heb je enig idee wat een probleem zou kunnen zijn?
Bij voorbaat dank!
Hallo
Het toeval is dat ik bezig ben met automatische nomenclatuur en deze macro komt net op tijd. Ik heb alleen één probleem, namelijk dat het informatie ophaalt over onderdelen van het eerste niveau en niet over onderdelen in een assemblage of subassemblage van subassemblage van assemblage enz.
Is er een oplossing?
Bedankt
Moge de kracht met je zijn.
Hallo OBI WAN,
Ja, er is een oplossing, u vervangt de regel "BomType = swBomType_TopLevelOnly" door "BomType = swBomType_Indented", dit zou de nomenclatuur op meerdere niveaus moeten plaatsen.
Vriendelijke groeten
Hallo S.Descamps,
Heeft u het pad naar uw BOM-sjabloon correct vervangen in de regel "TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt""?
Of de naam van de configuratie met een geldige configuratie in de regel "Configuration = "Default""?
Vriendelijke groeten
Hallo
Ik kan de macro die door @d.roger wordt genoemd niet downloaden 
Weet iemand waarom?
Bij voorbaat dank!
Hallo
Ik denk dat het te maken heeft met het feit dat het bestand op de oude url van de site staat. Niet veilig, dus de browser loopt vast (althans dat gebeurt thuis)
Hallo;
Ik heb geen problemen met het downloaden (Firefox?), hier is het (weer):
insert-bom-asm.swp (77.5 kB)
en als het echt niet werkt, hier is de " Typescript " versie:
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_TopLevelOnly
Configuration = "Défaut"
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
For I = 0 To NumRow
For J = 0 To NumCol
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
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 NomProperty As String
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager
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) = "DESSINATEUR" Then
NomProperty = ResolvedValOut
End If
Next K
Dim chemin As String
chemin = Environ("USERPROFILE") & "\Desktop\" & swModel.GetTitle & "-" & NomProperty & ".xls"
With xlApp
wbk.SaveAs chemin
wbk.Close
.Quit
End With
End Sub
Vriendelijke groeten.
Hallo
Op deze link werkt het. Op de originele op Edge genereert het een fout met betrekking tot de beveiliging van de download.
Nou, dat is het... Zijn er mensen die " Edge " gebruiken!!
Geen keuze 