Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Alle Verzeichnisse durchlaufen, Zeichnungen öffnen/schließen

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Alle Verzeichnisse durchlaufen, Zeichnungen öffnen/schließen (3182 mal gelesen)
Enduro
Mitglied
Wirtschaftsinformatik Studentin


Sehen Sie sich das Profil von Enduro an!   Senden Sie eine Private Message an Enduro  Schreiben Sie einen Gästebucheintrag für Enduro

Beiträge: 53
Registriert: 27.07.2012

Hallo Forum :-)
Win 7
Office 2007
Autodesk® Inventor® 2012

erstellt am: 29. Okt. 2012 15:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo  

Ich brauche wieder Eure Hilfe! Code unten funkt aber nach kurzer Zeit stürzt der Inventor ganz ab. Weiß wer was hier los ist? Ich habe auch schon versucht Error Handling einzubauen und viel rumprobiert, es hilft alles nicht.

Aufgabe fürs Makro: es soll alle Zeichnungen öffnen, ein anderes Makro laufen lassen, nämlich, den BlockDefinition auf aktuelle Vorlage aktualisieren und schließen. und so alle Zeichnungen unter allen Kunden.

Kein Fehlermeldung, es läuft kurz und dann stürzt Inventor ab und schließt alles.  


Code:
Sub ForEachSubPath(StartFolder As String)
   Dim sName As String
   Dim FileName As String
   Dim FolderName As String
   Dim Dirs() As String
   Dim DirsNo As Integer
   Dim i As Integer
   
    On Error Resume Next
   
   'Eventuell Backslash anhängen
   If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

   'Alle Dateien des Verzeichnisses auflisten
   sName = Dir(StartFolder & "*.idw")

   While sName <> ""
      FileName = StartFolder & sName 'Filename enthält dann die aktuelle Datei


    If Err Then
        Resume Next
       
        End If
       
        'Dateien öffnen und Skripte ausführen
        Dim oDoc As Inventor.Document
        Set oDoc = ThisApplication.Documents.Open(FileName)
        Call BlockDefinitionAendern_.BlockDefinitionAendern
        'Call BlockDefinitionAendern_.PDFGenerator_A
        oDoc.Save2
        oDoc.Close
       
       
      sName = Dir
   Wend

   'Alle Unterverzeichnisse in Array einlesen
   DirsNo = 0
   sName = Dir(StartFolder, vbDirectory)

   While sName <> ""
      If sName <> "." And sName <> ".." And sName <> "Ungültig" And Left(sName, 3) <> "Old" Then
         DirsNo = DirsNo + 1
         ReDim Preserve Dirs(DirsNo) As String
         Dirs(DirsNo - 1) = sName
      End If
      sName = Dir
   Wend

   For i = 0 To DirsNo - 1
      FolderName = StartFolder & Dirs(i) & "\"
      ForEachSubPath (FolderName)

      '--------------------------------------
     
  Next
End Sub

Sub test()
Dim KundenName As String
KundenName = Dir("I:\Kunden", vbDirectory)

On Error Resume Next

While KundenName <> ""
'    If Err Then
'
'        Exit Sub
'
'    End If
    'On Error Resume Next
   
If KundenName <> "." And KundenName <> ".." And KundenName <> "Ungültig" And Left(KundenName, 3) <> "Old" Then
KundenName = Dir(KundenName, vbDirectory)

   
ForEachSubPath KundenName
    
'     KundenName = Dir
    
    End If
   
Wend
  
End Sub


Danke im Voraus für die Hilfe!


------------------
----------------
Viele Grüße
Endu

[Diese Nachricht wurde von Enduro am 29. Okt. 2012 editiert.]

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 29. Okt. 2012 16:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Enduro 10 Unities + Antwort hilfreich

Hi

Lass es mal laufen und beobachte im Taskmanager die Speicherauslastung. Wenn die Verzeichnisse viele Dateien beinhalten bzw. die Zeichnungen sehr groß sind, geht dir vielleicht schlicht der RAM aus. Da wäre mit einem VBA-Makro nicht viel zu machen.
Das Austauschen von Zeichnungsressourcen geht mW auch mit dem Aufgabenplaner.

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

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

Enduro
Mitglied
Wirtschaftsinformatik Studentin


Sehen Sie sich das Profil von Enduro an!   Senden Sie eine Private Message an Enduro  Schreiben Sie einen Gästebucheintrag für Enduro

Beiträge: 53
Registriert: 27.07.2012

Hallo Forum :-)
Win 7
Office 2007
Autodesk® Inventor® 2012

erstellt am: 29. Okt. 2012 16:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Ralf,

Danke für den Feedback. Was für ein Aufgabenplaner? Wo gibt es sowas? Und was ist mW?
Was ich da auszutauschen versuch sind block definition, dafür hab ich extra einen Makro und ich wollte nacher noch ein anderes Makro durchlaufen lassen.

Lässt sich da nichts mit RAM machen? Ich hab auch schon PC neu gestartet, trotzdem das gleiche. Und ich hab 16 GB RAM 

Danke

------------------
----------------
Viele Grüße
Endu

[Diese Nachricht wurde von Enduro am 29. Okt. 2012 editiert.]

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 29. Okt. 2012 17:03    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Enduro 10 Unities + Antwort hilfreich

Hallo

mw = meines Wissens

Der Aufgabenplaner findet sich im Startmenü unter Autodesk/Autodesk Inventor 2012/Extras/Aufgabenplanung.

Wenn Inventor so sang- und klanglos abschmiert ist es schwierig überhaupt die Ursache zu finden. Es könnte auch eine Variable sein, die leer ist und es nicht sein sollte oder oder oder. Wie lange läuft das Makro denn in etwa? Kommt der Absturz immer nach etwa der gleichen Zeit oder Anzahl Dateien? Du versuchst eine Blockdefinition auszutauschen. Sicher das die auch in jeder Datei enthalten ist?
Wie ich in einem anderen Beitrag schon erwähnte, "On error resume next" zu Beginn des Codes ist die Seuche schlechthin. Damit läuft Inventor wirklich über alle Fehler hinweg, bis es überhaupt nicht mehr geht. Nimm das raus und kümmere dich zuerst um die "normalen" Fehler die dann eventuell auftreten. Vielleicht beseitigst du so den Crash gleich mit.

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

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

Enduro
Mitglied
Wirtschaftsinformatik Studentin


Sehen Sie sich das Profil von Enduro an!   Senden Sie eine Private Message an Enduro  Schreiben Sie einen Gästebucheintrag für Enduro

Beiträge: 53
Registriert: 27.07.2012

Hallo Forum :-)
Win 7
Office 2007
Autodesk® Inventor® 2012

erstellt am: 30. Okt. 2012 16:19    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Ralf,

Danke für dein Antwort.

Hat sich erledigt, es läuft     

Code:
Public Function InUnterVerzSuchen(VerzPfad As String, DateiTyp As String, Attrib As Integer)
    Dim VerzName As String, DateiName As String, VerzListe() As String, DateiNr As Integer
    Dim VerzNr As Integer, DateiListe() As String, TempListe, Nr As Integer
   
    ' Liste mit Dateinamen erstellen
  If Right$(VerzPfad, 1) = "\" Then
      DateiName = Dir$(VerzPfad & DateiTyp, Attrib)
      'MsgBox DateiName
     
  Else
      DateiName = Dir$(VerzPfad & "\" & DateiTyp, Attrib)
    ' MsgBox DateiName
     
  End If
    DateiNr = 0
   
    While DateiName <> vbNullString
        If (DateiName <> ".") And (DateiName <> "..") Then
            DateiNr = DateiNr + 1
            ReDim Preserve DateiListe(1 To DateiNr)
            DateiListe(DateiNr) = VerzPfad & "\" & DateiName
        End If
        DateiName = Dir$()
    Wend
   
    ' Liste mit Unterverzeichnissen erstellen
    VerzNr = 0
    VerzName = Dir(VerzPfad & "\", Attrib Or vbDirectory)
   
    While VerzName <> vbNullString
        If (VerzName <> ".") And(VerzName <> "..") And VerzName <> "Ungültig" And Left(VerzName, 3) <> "Old" Then
             

    If Right(VerzName, 4) = ".idw" Then
       
        ThisApplication.Documents.Open (VerzPfad & "\" & VerzName)
       
                    Dim Rev As String
                    Dim Bauteil As String
                   
                    Dim oDrawDoc As DrawingDocument
                    Set oDrawDoc = ThisApplication.ActiveDocument
                   
                    'Get the PropertySets
                    Dim oPropertySets As PropertySets
                    Set oPropertySets = oDrawDoc.PropertySets
                   
                    Dim oPropertySet As PropertySet
                    Set oPropertySet = oDrawDoc.PropertySets.Item("Inventor Summary Information")
                   
                    'Get the Property
                    Dim oProperty As Property
                   
                    On Error Resume Next
                   
                    'Revisionsnummer von dem Erstansicht
                    Dim oReferencedPartDoc As Document
                    Set oReferencedPartDoc = oDrawDoc.ReferencedDocuments.Item(1)
                   
                    Set oDrawDoc = ThisApplication.ActiveDocument
                   
                    ' Create the new title block defintion.
                    Dim oTitleBlockDef As TitleBlockDefinition
                    Set oTitleBlockDef = oDrawDoc.ActiveSheet.TitleBlock.Definition
                   
                    Dim a As String
                    Dim b As String
                   
                    Dim oSketch As DrawingSketch
                   
                    Call oTitleBlockDef.Edit(oSketch)
                    a = oSketch.TextBoxes.Item(22).Text
                   
                    Dim oPropValue As String
                    oPropValue = oReferencedPartDoc.PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").Item("Part Number").Value
                   
                    If Len(oPropValue) < 10 Then
                   
                    oSketch.TextBoxes.Item(22).FormattedText = "<StyleOverride FontSize='0,6'><Property Document='model' PropertySet='Design Tracking Properties' Property='Part Number' FormatID='{32853F0F-3444-11D1-9E93-0060B03C1CA6}' PropertyID='5'>BAUTEILNUMMER</Property></StyleOverride><StyleOverride FontSize='0,6'> Rev </StyleOverride><StyleOverride FontSize='0,6'><Property Document='model' PropertySet='Inventor Summary Information' Property='Revision Number' FormatID='{F29F85E0-4FF9-1068-AB91-08002B27B3D9}' PropertyID='9'>REVISIONSNUMMER</Property></StyleOverride>"
                    Else:
                   
                    oSketch.TextBoxes.Item(22).FormattedText = "<StyleOverride FontSize='0,4'><Property Document='model' PropertySet='Design Tracking Properties' Property='Part Number' FormatID='{32853F0F-3444-11D1-9E93-0060B03C1CA6}' PropertyID='5'>BAUTEILNUMMER</Property></StyleOverride><StyleOverride FontSize='0,4'> Rev </StyleOverride><StyleOverride FontSize='0,4'><Property Document='model' PropertySet='Inventor Summary Information' Property='Revision Number' FormatID='{F29F85E0-4FF9-1068-AB91-08002B27B3D9}' PropertyID='9'>REVISIONSNUMMER</Property></StyleOverride>"
                    End If
                   
                    Call oTitleBlockDef.ExitEdit
                   
                    Call PDFGenerator_A
                   
                    oDrawDoc.Save2
                    oDrawDoc.Close
               
       
            ' Handelt es sich um ein Verzeichnis ?
            ElseIf GetAttr(VerzPfad & "\" & VerzName) And vbDirectory Then
                VerzNr = VerzNr + 1
                ReDim Preserve VerzListe(1 To VerzNr)
                VerzListe(VerzNr) = VerzName
            'End If
            End If
        End If
        VerzName = Dir$() ' Nächsten Datei- oder Verzeichnisnamen holen
  Wend
   
    ' Rekursiver Aufruf, um Unterverzeichnisse zu durchsuchen
    For VerzNr = 1 To VerzNr
        TempListe = InUnterVerzSuchen(VerzPfad & "\" & VerzListe(VerzNr), DateiTyp, Attrib)
        If IsArray(TempListe) Then
            For Nr = LBound(TempListe) To UBound(TempListe)
                DateiNr = DateiNr + 1
                ReDim Preserve DateiListe(1 To DateiNr)
                DateiListe(DateiNr) = TempListe(Nr)
            Next Nr
        End If
    Next VerzNr
    If DateiNr = 0 Then InUnterVerzSuchen = False Else InUnterVerzSuchen = DateiListe()
End Function

Sub test()

Call InUnterVerzSuchen("I:\Kunden", ".idw", vbDirectory)
MsgBox "Fertig!"


End Sub


Danke,

------------------
----------------
Viele Grüße
Endu

[Diese Nachricht wurde von Enduro am 05. Nov. 2012 editiert.]

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz