Hallo ihr alle
Ziel ist es, über ein VBA-Makro automatisch einen Namen in einer Baugruppe zu erstellen und ihn in eine Excel-Datei zu exportieren, deren Name der Name der Teiledatei + eine benutzerdefinierte Eigenschaft ist. Schließlich muss das Makro die erstellte Stückliste löschen.
Wir haben keine My Cad-Tools - Solidworks Prenium
Hallo
Es sieht sehr nach einer Stellenanzeige aus lol
Haben Sie sonst angefangen, sich den Makrorecorder anzusehen?
Herzliche Grüße
Hallo
Haben Sie schon ein Stück Code, das Sie uns zeigen möchten?
Dimitri.
Hallo
Schauen Sie sich das angehängte Makro an, normalerweise ist alles da (etwas locker und ohne Sicherheitsüberprüfungen). Ändern Sie mindestens die Zeilen:
TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"
Konfiguration = "Standard"
Wenn vPropNames(K) = "CARTOONIST" dann
Um den Pfad zu Ihrer Stücklistenvorlage, den Namen Ihrer Standardkonfiguration in Ihrem ASMS und den Namen Ihrer benutzerdefinierten Eigenschaft, die Sie im Dateinamen haben möchten, einzufügen.
Herzliche Grüße
Vielen Dank für Ihre Antwort d.roger, das Makro funktioniert, nur kleines Problem, wenn ich die benutzerdefinierte Eigenschaft dort einfüge, wo Sie mir gesagt haben, dass der Wert der Eigenschaft nicht im Dateinamen zurückgegeben wird. Ich habe den Eindruck, dass die Zeile, die den Namen der Datei im Makro erstellt, keine Erinnerung an die Eigenschaft enthält, ich habe versucht, sie hinzuzufügen, aber die Tests sind auf dieser Seite nicht schlüssig.
Hallo
Sie müssen die 2 Zeilen ersetzen:
Legen Sie config = swModel.GetActiveConfiguration fest
Legen Sie cusPropMgr = config fest. CustomPropertyManager
, die den in der aktiven Konfiguration angeforderten Wert abrufen durch:
Set cusPropMgr = swModelDocExt.CustomPropertyManager("")
wodurch der Wert auf der Registerkarte "Anpassen" abgerufen wird
Herzliche Grüße
Perfekt, indem ich diese Modifikation vornehme, funktioniert das Makro so, wie ich es wollte. Nur zur Verbesserung ist es möglich, die Tabelle im selben Ordner wie die Baugruppe zu speichern.
Hallo
Ja, es ist möglich, Sie ersetzen die Leitung:
path = About("USERPROFILE") & "\Desktop\" & Links(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "-" & PropertyName & ".xlsx"
bis:
path = Links(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & Eigenschaftsname & ".xlsx"
Herzliche Grüße
Hallo
Wenn Sie Ihrer Excel-Datei auch ein wenig Layout geben möchten, können Sie Zeilen wie zum Beispiel hinzufügen:
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
Statt:
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
Die Zeile:
xlApp.ActiveSheet.Cells(I + 1, J + 1). NumberFormat = "@"
ist besonders interessant, wenn Sie numerische Werte haben, die mit 0 beginnen, da die Excel-Zelle dadurch in Textformat versetzt wird und somit vermieden wird, dass die 0 am Anfang verloren geht.
Herzliche Grüße
Hallo
Zunächst einmal vielen Dank für das Teilen, es ist wirklich toll , hier Informationen dieser Qualität zu finden!
Ich versuche, das Makro für den Stücklistenexport einzurichten . Leider bekomme ich es nicht zum Laufen.
Ich bekomme die Meldung "Laufzeitfehler 91 Objektvariable oder Blockvariable mit nicht definiert" auf folgende Zeilen:
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(Vorlagenname, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature
Haben Sie eine Idee, was ein Problem sein könnte?
Vielen Dank im Voraus!
Hallo
Der Zufall ist, dass ich an einer automatischen Nomenklatur arbeite und dieses Makro gerade rechtzeitig kommt. Ich habe nur ein Problem, nämlich dass es Informationen zu Teilen der ersten Ebene und nicht zu Teilen in einer Baugruppe oder Unterbaugruppe einer Unterbaugruppe einer Baugruppe usw. abruft.
Gibt es eine Lösung?
Vielen Dank
Möge die Macht mit euch sein.
Hallo OBI WAN,
Ja, es gibt eine Lösung, Sie ersetzen die Zeile "BomType = swBomType_TopLevelOnly" durch "BomType = swBomType_Indented", dies sollte die Nomenklatur in mehrere Ebenen bringen.
Herzliche Grüße
Hallo S.Descamps,
Haben Sie den Pfad zu Ihrer Stücklistenvorlage in der Zeile "TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"" korrekt ersetzt?
Oder den Namen der Konfiguration mit gültiger Konfiguration in der Zeile "Configuration = "Default""?
Herzliche Grüße
Hallo
Ich kann das von @d.roger erwähnte Makro nicht herunterladen 
Weiß jemand warum?
Vielen Dank im Voraus!
Hallo
Ich denke, es hängt damit zusammen, dass sich die Datei auf der alten URL der Website befindet. Nicht sicher, so dass der Browser einfriert (zumindest passiert das zu Hause)
Hallo;
Ich habe keine Probleme es herunterzuladen (Firefox?), hier ist es (wieder):
insert-bom-asm.swp (77.5 KB)
und wenn es wirklich nicht funktioniert, hier ist die " Typescript " -Version:
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
Herzliche Grüße.
Hallo
Unter diesem Link funktioniert es. Auf dem ursprünglichen auf Edge wird ein Fehler im Zusammenhang mit der Sicherheit des Downloads generiert.
Nun, das war's... Gibt es Leute, die " Edge " verwenden!!
Keine Wahl 