Guten morgen Stefan,
danke für die schnelle Antwort.
Wo im Makro muss ich ansetzen ?
Ich rufe in meinem Makro verschiedene Formulare auf.
Die Zuordnung basiert auf dem Format des Dateinamens (Kundenspezifisch).
Ist das Identifizieren anhand des Dateinamens in der BG auch möglich ?
Hier ist mal das Modul:
Option Explicit
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swDocDRAWING = 3
' Hier werden die Dateinamen anhand ihres Formats dem Kunden zugeordnet.
' Trifft kein Kriteriun zu, wird das Auswahlmenü "Kundenauswahl" aufgerufen.
' Dort kann dann entschieden werden, ob man das Makro beenden will oder einen Kunden manuell auswählen möchte.
Sub main()
Dim swApp As Object
Dim Model As Object
Dim iPos As Integer ' Variable für 1. Punkt
Dim vPos As Integer ' Variable für 2. Punkt
Dim uPos1 As Integer ' Variable für 1. Unterstrich
Dim uPos2 As Integer ' Variable für 2. Unterstrich
Dim uPos3 As Integer ' Variable für 3. Unterstrich
Dim uPos4 As Integer ' Variable für 4. Unterstrich
Dim wPos1 As Integer ' Variable für 1. Bindestrich
Dim wPos2 As Integer ' Variable für 2. Bindestrich
Dim kPos As Integer ' Variable für Kaufteile
Dim instr As Integer
Dim fso As New FileSystemObject ' Variablen Kaufteilerfassung
Dim oFolder As Folder '
' am Anfang Werte auf "0" setzen
iPos = 0
vPos = 0
uPos1 = 0
uPos2 = 0
uPos3 = 0
uPos4 = 0
wPos1 = 0
wPos2 = 0
kPos = 0
Set swApp = CreateObject("SldWorks.Application")
swApp.Visible = True
Set Model = swApp.ActiveDoc
' wenn nix geladen direkt wieder raus
If Model Is Nothing Then
Call MsgBox("Keine Datei" & vbNewLine & " geöffnet", vbOKOnly + vbInformation + vbApplicationModal, " INFORMATION")
End
End If
' Abfragen der einzelnen kundenspezivischen Dateivarianten
' sucht den Punkt ab dem 1. Zeichen
' iPos = 5 (Vill)
iPos = InStr(1, Model.GetTitle, ".", vbTextCompare)
If iPos = 0 Then iPos = Len(Model.GetTitle) + 1
' sucht den Punkt ab dem 7. Zeichen
' vPos = 10 (Vill)
vPos = InStr(7, Model.GetTitle, ".", vbTextCompare)
' Suche der Unterstriche Sollwert
uPos1 = InStr(1, Model.GetTitle, "_", vbTextCompare) ' 2
uPos2 = InStr(4, Model.GetTitle, "_", vbTextCompare) ' 6
uPos3 = InStr(8, Model.GetTitle, "_", vbTextCompare) ' 10
uPos4 = InStr(12, Model.GetTitle, "_", vbTextCompare) ' 14
' Suche der Bindestriche Sollwert
wPos1 = InStr(1, Model.GetTitle, "-", vbTextCompare) ' 7
wPos2 = InStr(9, Model.GetTitle, "-", vbTextCompare) ' 11 (10 bei 2stelliger Baugruppennummer)
' Abfrage Kaufteile nach Firmenname im Kaufteilordner.
' Der Firmennamen muss an der 1. oder 2. Stelle des Dateinamens anfangen.
' Bei Standardkaufteilen ist ein Unterstrich ("_") am Anfang, deshalb auch noch an 2. Stelle
' Auswahl des entsprechenden Formulars bezogen auf den Dateinamen, dann mit ".show" auf den Bildschirm bringen
If iPos = 5 And vPos = 10 Then
Kunde1.Show
ElseIf (uPos1 = 2) And (uPos2 = 6) And (uPos3 = 10) And (uPos4 = 14) And iPos > 18 Then
Kunde2.Show
ElseIf ((wPos1 = 7) And (wPos2 = 10 Or wPos2 = 11)) Or (kPos = 1 Or kPos = 2) Then
' Zeichnungsnummer Firmenname Kaufteil
Weber.Show
ElseIf iPos > 15 Then
' Vergleich Firmenname mit Ordnername im Kaufteilordner
For Each oFolder In fso.GetFolder("H:\_Kaufteile_Weber").SubFolders ' Kaufteilordner
kPos = InStr(1, Model.GetTitle, oFolder.Name, vbTextCompare)
If (kPos = 1) Or (kPos = 2) Then
Exit For
End If
Next
If (kPos = 1 Or kPos = 2) Then
Weber.Show
Else
Kundenauswahl.Show
End If
Else
Kundenauswahl.Show
End If
End Sub
Das ganze mag nicht ganz professionell aussehen (bin absoluter Laie), aber es funz.
Is ja alles nur geklaut 
Die ein oder andere Codezeile würde es mir leichter machen.
Danke
ciao
------------------
Viele Wege führen zum Ziel .......... und ich will alle wissen !
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
kalppt das ja, die hat aber nicht die Funktionen meines Makros.
