| | | 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
Beiträge: 53 Registriert: 27.07.2012 Hallo Forum :-) Win 7 Office 2007 Autodesk® Inventor® 2012
|
erstellt am: 29. Okt. 2012 15:11 <-- editieren / zitieren --> Unities abgeben:
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
Beiträge: 2166 Registriert: 15.11.2006 Windows 10 x64, AIP 2022
|
erstellt am: 29. Okt. 2012 16:10 <-- editieren / zitieren --> Unities abgeben: Nur für Enduro
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
Beiträge: 53 Registriert: 27.07.2012 Hallo Forum :-) Win 7 Office 2007 Autodesk® Inventor® 2012
|
erstellt am: 29. Okt. 2012 16:21 <-- editieren / zitieren --> Unities abgeben:
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
Beiträge: 2166 Registriert: 15.11.2006 Windows 10 x64, AIP 2022
|
erstellt am: 29. Okt. 2012 17:03 <-- editieren / zitieren --> Unities abgeben: Nur für Enduro
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
Beiträge: 53 Registriert: 27.07.2012 Hallo Forum :-) Win 7 Office 2007 Autodesk® Inventor® 2012
|
erstellt am: 30. Okt. 2012 16:19 <-- editieren / zitieren --> Unities abgeben:
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 >>)
|