---

Hallo Forum,
gibt es eine Möglichkeit, von all unseren IPTs und IAMs per Routine Bilder zu erzeugen?

Die Bilder sollten den gleichen Dateinamen 12345678.IPT > 12345678.JPG
Die Grfikauflösung sollte wählbar sein, z.B. 800x600
Der Speicherordner sollte wählbar sein.
Die Routine sollte alle Unterordner durchlaufen.

Vielen Dank schon jetzt...
Grüße aus Hessen
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Hier schon mal ein Beispiel zum Erstellen der JPG's in VBA und eines für .NET.

Für das Zielverzeichnis vierlleicht etwas wie:

Code:

---

Dim objShell  As Shell32.Shell
Dim objFolder  As Shell32.Folder

Const BIF_RETURNONLYFSDIRS = &H1&

Set objShell = New Shell32.Shell
Set objFolder = objShell.BrowseForFolder(0, "Wählen Sie einen Ordner aus:", _
                    BIF_RETURNONLYFSDIRS, "C:\Windows")

If Not objFolder Is Nothing Then
  Debug.Print objFolder.Items.Item.Path
Else
  '// "Abbrechen" gewählt
End If

---

Zu Rekursion durch Unterverzeichnisse finden sich im Netz Beispiel zuhauf.

Eine Warnung noch. Wenn es sich um hunderte oder tausende von Dateien handelt, mach das nicht mit VBA oder schreib ein Logfile mit welche Dateien erffolgreich exportiert wurden. Es wird mit Sicherheit zwischendurch zu Abstürzen kommen.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
vielen Dank für den Tipp, das erste Beispiel ist fast genau was ich wollte. Bin nun noch auf der Suche nach den Unterverzeichnissen.
Eine Frage hab ich noch, im Forum fand ich leider nichts oder hab nach den falschen Begriffen gesucht. Gibt es ne Möglichkeit, wenn ich mit der Maus über das Icon fahre, dass dann ein erklärender Text aufpoppt?
Also, nochmals vielen Dank...
Gruß Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Die Icons für VBA-Makros in der Ribbonleiste, die über "Benutzerbefehle anpassen" eingefügt wurden, können meines Wissens nicht mit einem Tooltip versehen werden.

Rekursion durch Verzeichnisse:

Code:

---

Dim objFSO As Object

Sub TestIt()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    GetFiles ("C:\tmp\mytest") '<--- den fixen Pfad durch den im Dialog gewählten Anfangspfad ersetzen !!!
End Sub

Sub GetFiles(ByVal strDirectory)
    Set objFolder = objFSO.GetFolder(strDirectory)
    For Each objFile In objFolder.Files
        Debug.Print objFile.Path '<--- statt der Zeile dein Exportmakro aufrufen, Dateityp (ipt oder?) prüfen nicht vergessen
    Next
    For Each objFolder In objFolder.SubFolders
        GetFiles objFolder.Path
    Next
End Sub

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
vielen Dank für Deine Antwort. Ich komme nicht ganz klar damit, weiß nicht, wie ich ein Macro in einem Macro starte... Das Macro welches die Bilder exportiert, ist folgendes:

Code:

---

Public Sub SaveImages()
    ' Specify the size of the output image in pixels.  If you
    ' use zero then it will be the actual size of the window.
    Dim pixelWidth As Integer
    Dim pixelHeight As Integer
    pixelWidth = 800
    pixelHeight = 800

    ' Specify the path where the files exist.  The rest of the
    ' code expects this path name to end with a backslash.
    Dim dirName As String
    dirName = "c:\bilder\"

    ' Loop through the files in the specified directory.
    ' Depending on the file type you want to generate the
    ' images for you may need to change the file extension.
    ' In this case it will create images for all the part
    ' files in the specified directory.  Editing "*.ipt" to
    ' "*.iam" will generate images for all assemblies.
    Dim filename As String
    filename = Dir(dirName & "*.*")
    Do While filename <> ""
        ' Save the current silent operation state.
        Dim silentState As Boolean
        silentState = ThisApplication.SilentOperation

        ' Turn on silent operation.
        ThisApplication.SilentOperation = True

        ' Open the document.
        Dim doc As Document
        Set doc = ThisApplication.Documents.Open(dirName & filename)

        ' Restore the state to its previous value.
        ThisApplication.SilentOperation = silentState

        ' Get the currently active view, which will be for
        ' the document just opened.
        Dim window As View
        Set window = ThisApplication.ActiveView

        ' Create the filename for the output file.  This uses
        ' the same name as the original file and replaces the
        ' extension with .jpg
        Dim imageFilename As String
        imageFilename = dirName & _
                        Left$(filename, InStr(filename, ".")) & "jpg"
        Call window.SaveAsBitmap(imageFilename, _
                                pixelWidth, pixelHeight)

        ' Close the current document.
        Call doc.Close(True)

        ' Get the next filename.
        filename = Dir
    Loop

    ThisApplication.StatusBarText = "Finished processing."
End Sub

---

Vielleicht könntest Du mir kurz die beiden Macros vereinen. Ich habe von VBA so gut wie keine Ahnung 
Vielen Dank und viele Grüße
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Konnte es jetzt nicht testen, aber sollte gehen.
Das Startverzeichnis sollte man nicht vorbelegen, sonst kommt man darüberliegende Verzeichnisse nicht dran.

Code:

---

'VBA select folder relies upon the Microsoft Shell Controls And Automation object library.
'You will need to set a Reference to it. In the VBA Editor's Tools menu, click References...
'scroll down to "Microsoft Shell Controls And Automation" and choose it.
'We have to add it to be able to use the Shell32 library.

Public objFSO As Object

Public Sub SaveImages()
   
    ' Specify the path where the files exist.  The rest of the
    ' code expects this path name to end with a backslash.
    Dim dirName As String
    'dirName = "c:\bilder\"
    Dim objShell As Shell32.Shell
    Dim objFolder  As Shell32.Folder

    Const BIF_RETURNONLYFSDIRS = &H1&

    Set objShell = New Shell32.Shell
    Set objFolder = objShell.BrowseForFolder(0, "Wählen Sie einen Startordner aus:", BIF_RETURNONLYFSDIRS)

    If Not objFolder Is Nothing Then
        Debug.Print objFolder.Items.Item.Path
        dirName = objFolder.Items.Item.Path
    Else
    '// "Abbrechen" gewählt
        Exit Sub
    End If
   

    ' Loop through the files in the specified directory.
    ' Depending on the file type you want to generate the
    ' images for you may need to change the file extension.
    ' In this case it will create images for all the part
    ' files in the specified directory.  Editing "*.ipt" to
    ' "*.iam" will generate images for all assemblies.
    'Dim filename As String
    'filename = Dir(dirName & "*.*")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    GetFiles (dirName)

    ThisApplication.StatusBarText = "Finished processing."
End Sub

Sub GetFiles(ByVal strDirectory)

    ' Specify the size of the output image in pixels.  If you
    ' use zero then it will be the actual size of the window.
    Dim pixelWidth As Long
    Dim pixelHeight As Long
    pixelWidth = 800
    pixelHeight = 600
   
    Set objFolder = objFSO.GetFolder(strDirectory)
    Dim objfile As Object
    For Each objfile In objFolder.Files
        'Debug.Print objFile.Path
       
        'Erstmal gucken, ob's eine ipt ist
        If UCase(Right(objfile.Name, 3)) = "IPT" Then
       
        ' Save the current silent operation state.
        Dim silentState As Boolean
        silentState = ThisApplication.SilentOperation

        ' Turn on silent operation.
        ThisApplication.SilentOperation = True

        ' Open the document.
        Dim doc As Document
        Set doc = ThisApplication.Documents.Open(objfile.Path)

        ' Restore the state to its previous value.
        ThisApplication.SilentOperation = silentState

        ' Get the currently active view, which will be for
        ' the document just opened.
        Dim window As View
        Set window = ThisApplication.ActiveView

        ' Create the filename for the output file.  This uses
        ' the same name as the original file and replaces the
        ' extension with .jpg
        Dim imageFilename As String
        'Debug.Print InStrRev(objfile.Name, ".")
        imageFilename = strDirectory & "\" & Left$(objfile.Name, InStrRev(objfile.Name, ".")) & "jpg"
       
        Call window.SaveAsBitmap(imageFilename, pixelWidth, pixelHeight)

        ' Close the current document.
        Call doc.Close(True)

        End If
    Next
    For Each objFolder In objFolder.SubFolders
        GetFiles (objFolder.Path)
    Next
End Sub

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
vielen Dank für Deine Hilfe... ich bekomme eine Fehlermeldung -

Compile error: User-defined type not defined

Dim objShell As Shell32.Shell

Viele Grüße
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Lies mal die ersten 4 Kommentarzeilen ganz oben im Code. 

Mir ist noch aufgefallen, das er die Bilder in das Verzeichnis der Upsprungsdatei speichert, statt nach z.B. C:\Bilder.
In der Zeile:

Code:

---

imageFilename = strDirectory & "\" & Left$(objfile.Name, InStrRev(objfile.Name, ".")) & "jpg"

---

strDirectory durch "C:\Bilder" ersetzen, dann sollte es erstmal gehen.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
danke Dir erneut für Deine Hilfe... ich war einige Tage verhindert und komme erst jetzt wieder zu dem Programm. Das mit dem "Microsoft Shell Controls And Automation" habe ich ausgeführt.
Das Programm startet und es öffnet ein Fenster in dem ich das Startverzeichnis wähle. Nach dem Auswählen kommt eine Meldung:  "Run-time error '424'  Object required
Im Debugger wird die Zeile:

Set objFolder = objFSO.GetFolder(strDirectory)

gelb markiert. Was kann das sein?

Viele Grüße aus Hessen
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Ich vermute dir fehlt noch die Referenz auf die "Microsoft Scripting Runtime". Also kontrolliere bitte mal unter Tools --> References, ob das Häkchen gesetzt ist.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
das habe ich gesetzt, leider ohne Erfolg. Es kommt nach wie vor die Fehlermeldung:

Set objFolder = objFSO.GetFolder(strDirectory)

Viele Grüße
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Ich konnte das Verhalten nur nachstellen, wenn ich die erste Zeile

Code:

---

Public objFSO As Object

---

in meinem Code oben auskommentiert habe. Hast du die Zeile eventuell versehentlich nicht mitkopiert oder gelöscht? Sonst gehen mir grad die Ideen aus.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
es geht, ich hab den Code in ein neues "Modul" kopiert - und da ging es.
Ich hab da noch eine Bitte, gib es ne Möglichkeit, dass von beiden Typen IPT und IAM Bilder erstellt werden. Im Moment erstellt der Code entweder IPT oder IAM (wenn ich den Code ändere).
Nochmals vielen Dank!!
Viele Grüße
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Ändere bitte

Code:

---

If UCase(Right(objfile.Name, 3)) = "IPT" Then

---

in

Code:

---

If UCase(Right(objfile.Name, 3)) = "IPT"  Or UCase(Right(objfile.Name, 3)) = "IAM" Then

---

Dann erzeugt er sowohl bei IPT, als auch bei IAM Bilder.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Ralf,
vielen herzlichen Dank - es funktioniert... 
Grüße aus Hessen
Martin

------------------
Wenn man einen Hund so dressiert hat, dass er über einen See fliegt, dann gibt es sicher ein paar Neider die das Tier für Wasserscheu halten...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo allerseits,

ich hätte mal eine Frage zu diesem Script:

Gibt es die Möglichkeit vor dem Speichern das Modell noch mal in die Ausgangsansicht zu drehen?

Danke und Gruß
Herbert

------------------
Gruß Herbert

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Setz mal vor

Code:

---

Dim window As View
Set window = ThisApplication.ActiveView

---

ein

Code:

---

ThisApplication.ActiveView.GoHome
       

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP