Hallo,
im Rahmen meiner Masterarbeit möchte ich ein PDM einrichten und ggf. alte Daten ebenfalls dort einpflegen. An der Universität gelten Konstruktionsrichtlinien, welche in den Dokumenteigenschaften den Autor, eine genauere Beschreibung sowie Material und Gewicht erfordern. Ich möchte ein kleines Makro erstellen, dass unter den Eigenschaften die Punkte "Description", "Author", "Material" mit dem Wert "SW-Material" und "Weight" mit dem Wert "SW-Mass" angelegt werden. Ich habe dazu auch schon ein Skript gefunden, nur leider sind meine Kenntnisse im Programmieren nicht so groß, dass ich es alleine schaffen werde. Das Problem in dem Skript ist, dass der Eintrag "bitte ausfüllen" in jede Zeile geschrieben wird. Ich möchte jedoch, dass ich für jede Zeile einen anderen Wert eintragen lassen kann. Irgendwas in der letzten Schleife müsste wohl geändert werden. Ich hoffe ihr könnt mir weiterhelfen. So nun das Skript und die Quelle: http://solidworks.cad.de/mm_35.htm
Const AllConfigs = 1
'
' unten noch die Properties eintragen!
'
' NICHT MEHR AB HIER EDITIEREN, es sei denn Sie wissen was sie tun ;-)
' **********************************************************************
' Definitions of typenames are consistent as in swconst.bas
Option Explicit
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swDocDRAWING = 3
Public Enum swCustomInfoType_e
swCustomInfoUnknown = 0
swCustomInfoText = 30 ' VT_LPSTR
swCustomInfoDate = 64 ' VT_FILETIME
swCustomInfoNumber = 3 ' VT_I4
swCustomInfoYesOrNo = 11 ' VT_BOOL
End Enum
Sub Main()
Dim swApp As Object
Dim ModelDoc As Object
Dim ConfigCount As Long
Dim ConfigNames As Variant
Dim PropConfigs As New Collection
Dim PropNames As New Collection
Dim Prop As Variant
Dim Config As Variant
Dim PropType As Long
Dim PropText As String
Dim i As Long
Set swApp = CreateObject("SldWorks.Application")
Set ModelDoc = swApp.ActiveDoc
If ModelDoc Is Nothing Then
' Call MsgBox("Keine Datei geöffnet", vbOKOnly, "Information")
Exit Sub
End If
'
' **********************************************************************
' diese folgenden Werte können editiert werden, hier einfach die Namen
' der Dateieigenschaften reinschreiben/ergänzen/Löschen
'
' die gewünschten Properties mal sammeln, ggf. einfach erweitern
PropNames.Add "Abendessen"
PropNames.Add "Einen-fuer-Mama"
PropNames.Add "Einen-fuer-Papa"
PropNames.Add "und-einen"
PropNames.Add "fuer-die-liebe-Oma"
' jetzt besser nicht mehr editieren
' **********************************************************************
' alle Dateieigenschaften aus der Konfiguration holen
ConfigCount = ModelDoc.GetConfigurationCount
ConfigNames = ModelDoc.GetConfigurationNames
' dann die Coolection vorbereiten mit den Namen der Konfigs bzw. "" wenn auf Datei
If AllConfigs = 0 Then
PropConfigs.Add ""
Else
For i = 0 To ConfigCount - 1
PropConfigs.Add ConfigNames(i)
Next i
End If
For Each Config In PropConfigs
For Each Prop In PropNames
' als Dateieigenschaft wieder einsetzen, Dummywert "bitte ausfüllen" eintragen
' und neu hinzufügen; falls schon vorhanden passiert nix
Debug.Print ModelDoc.AddCustomInfo3(Config, Prop, swCustomInfoText, "bitte ausfüllen")
Next
Next
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP