| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: speichern unter und Benutzer iProbs löschen (1702 mal gelesen)
|
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 02. Nov. 2020 17:22 <-- editieren / zitieren --> Unities abgeben:
Hallo liebe CAD Gemeinde; ich möchte gerne ein Model, Baugruppe ein zweites mal speichern und dabei die Benutzerdefinierten iProbs löschen. Den Code zum löschen der iProbs habe ich schon: ------------------------------------------------------------- Option Explicit Public Sub ClearAllUserDefinediProps() Dim oApp As Inventor.Application Set oApp = ThisApplication Dim oDoc As Document Set oDoc = oApp.ActiveDocument Dim oPropset As PropertySet Set oPropset = oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") Dim oProp As Property For Each oProp In oPropset oProp.Value = "" Next End Sub ------------------------------------------------------------------ Ich habe auch schon zwei Bilder in der Große von 16x16 und 32x32 gemacht, um ein Icon in die Benutzeroberfläche einzubinden.
'---------------------------------------------------------------------- ' Bild für Benutzeroberfläche '---------------------------------------------------------------------- Der Code sollte, soweit ich weiß :
Sub Kopieren.iProbs.loeschen () DIM Version Version = ThisApplication.SoftwareVersion.DisplayName MsgBox (Veersion) End Sub jetzt komme ich leider nicht weiter! Wer kann mir da helfen? VG Enric
------------------ Konstruktion Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 02. Nov. 2020 22:01 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
|
rkauskh Moderator Dipl.-Ing. (FH) Versorgungstechnik
Beiträge: 2166 Registriert: 15.11.2006 Windows 10 x64, AIP 2022
|
erstellt am: 03. Nov. 2020 10:48 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo Das Kopieren der Baugruppe kannst du mit folgendem Code erledigen. Es wird nur die Baugruppe kopiert. Unterbaugruppen und Bauteile bleiben original. Am Ende ruft der Code deine Sub zum Löschen der iProps auf. Code:
Option Explicit Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Sub SaveIAMCopy()
Dim oApp As Inventor.Application Set oApp = ThisApplication Dim oAssDoc As AssemblyDocument Set oAssDoc = oApp.ActiveDocument Dim sNewName As String Dim sOldName As String sOldName = Left$(oAssDoc.FullFileName, Len(oAssDoc.FullFileName) - 4) Dim oFileDialog As Inventor.FileDialog Call oApp.CreateFileDialog(oFileDialog) oFileDialog.Filter = "Inventor Files (*.iam)|*.iam|All Files (*.*)|*.*" oFileDialog.FilterIndex = 1 oFileDialog.DialogTitle = "Save Assembly Copy" oFileDialog.FileName = sOldName & "_COPY.iam" oFileDialog.CancelError = True On Error Resume Next oFileDialog.ShowSave If Err Then Exit Sub ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName End If Call oAssDoc.SaveAs(sNewName, False) 'Das Speichern der Baugruppe kann etwas dauern. While Not oApp.ActiveDocument.FullDocumentName = sNewName Sleep 100 DoEvents Wend Call ClearAllUserDefinediProps End Sub Private Sub ClearAllUserDefinediProps() Dim oApp As Inventor.Application Set oApp = ThisApplication Dim oDoc As Document Set oDoc = oApp.ActiveDocument Dim oPropSet As PropertySet Set oPropSet = oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") Dim oProp As Property For Each oProp In oPropSet oProp.Value = "" Next End Sub
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 03. Nov. 2020 18:05 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, Danke für Deine Hilfe! Der Code für die Icons, kann der mit eigebettet werden? Ich habe für die Benutzeroberfläche ein Icon erstellt! Das Bild heißt Modul1.Kopieren.iProbs.loeschen.long.bmp! VG Enric ------------------ Konstruktion [Diese Nachricht wurde von Enric am 03. Nov. 2020 editiert.] [Diese Nachricht wurde von Enric am 03. Nov. 2020 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: 03. Nov. 2020 21:34 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo Wie KraBBy schon geschrieben hat, die Bilder werden nicht mit Code eingebunden. Schau mal im Inventor unter "Extras" --> "Anwendungsoptionen" auf dem Reiter "Datei" nach dem Pfad für das "Vorgabe-VBA-Projekt". Normalerweise steht dort "C:\Users\Public\Documents\Autodesk\Inventor 2018\Macros". In den Pfad kopierst du deine beiden Bilder. ------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 04. Nov. 2020 12:53 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Dein Datei-Name des Bildes passt nicht. Modul1.Kopieren.iProbs.loeschen.long.bmp zum Vergleich, das Beispiel aus dem verlinkten Hilfe-Eintrag Module1.RotateCamera.Small.bmp Modulname.SubName.Small.bmp für 16x16 px Modulname.SubName.Large.bmp für 32x32 px
------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 04. Nov. 2020 15:24 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, das weiß ich, und ist bei mir auch richtig eingestellt! Wie aber bekommt das Bild in der Benutzerleiste dann den Befehl das speichern unter auszuführen? VG Enric ------------------ Konstruktion Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 04. Nov. 2020 16:27 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Ein Versuch der Erklärung (auch wenn Ralf angesprochen wurde): In der Benutzerleiste kann ein Makro-Befehl abgelegt werden. Wird dieser geklickt, wird das entsprechende Makro ausgeführt. Was also das Drücken des Knopfes auslöst, hängt ganz allein vom dem Makro ab. Hast Du mehrere Makros, die bestimmte Aktionen ausführen und nacheinander ablaufen sollen, dann kann man die z.B. in einem zusätzlichen Makro zusammenfassen. Sub Gesamtablauf() Call Kopie_speichern_Bsp() Call ClearAllUserDefinediProps() End Sub Auf die Benutzeroberfläche würde man dann nur den "Gesamtablauf" legen. (Oder, wie im Vorschlag von Ralf, am Ende des ersten Sub den Aufruf des zweiten platzieren. Dann ist das zusätzliche Makro "Gesamtablauf" überflüssig.) Das Bild ist bei dem Ganzen nur Beiwerk, damit nicht bei jedem Makro-Befehl auf der Benutzeroberfläche das gleiche "Default-Symbol" angezeigt wird. IV kuckt (beim Start) am Speicherort der .ivb nach passend benannten .bmp und verwendet das ggf. das Symbol. ------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 10. Nov. 2020 07:22 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, das habe ich nun verstanden! eine Frage wäre da noch: Der Code beschreibt ein Assembly, wenn der Code rausfinden soll ob es sich um ein Part oder ein Assembly handelt, dass ich kopieren möchte, wie sähe der Code denn dann aus? Danke für Deine Mühe Enric ------------------ Konstruktion Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 10. Nov. 2020 07:23 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, das habe ich nun verstanden! eine Frage wäre da noch: Der Code beschreibt ein Assembly, wenn der Code rausfinden soll ob es sich um ein Part oder ein Assembly handelt, dass ich kopieren möchte, wie sähe der Code denn dann aus? Danke für Deine Mühe Enric ------------------ Konstruktion 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: 10. Nov. 2020 08:44 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo Man kann das in eine Funktion packen. Der funktional gleiche Code für Bauteil und Baugruppe: Code:
Option Explicit Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Sub SaveModelCopy()
Dim oApp As Inventor.Application Set oApp = ThisApplication Dim oDoc As Document Set oDoc = oApp.ActiveDocument Dim sNewName As String Dim sOldName As String If Not oDoc.FullFileName = "" Then sOldName = Left$(oDoc.FullFileName, Len(oDoc.FullFileName) - 4) End If Dim oFileDialog As Inventor.FileDialog Call oApp.CreateFileDialog(oFileDialog) oFileDialog.FilterIndex = 1 oFileDialog.CancelError = True Select Case oDoc.DocumentType Case kPartDocumentObject: 'MsgBox "Part" Dim oPartDoc As PartDocument Set oPartDoc = oApp.ActiveDocument oFileDialog.Filter = "Inventor Files (*.ipt)|*.ipt|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Part Copy" oFileDialog.FileName = sOldName & "_COPY.ipt" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Sub ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName End If Call oPartDoc.SaveAs(sNewName, False) Case kAssemblyDocumentObject: 'MsgBox "Assembly" Dim oAssDoc As AssemblyDocument Set oAssDoc = oApp.ActiveDocument oFileDialog.Filter = "Inventor Files (*.iam)|*.iam|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Assembly Copy" oFileDialog.FileName = sOldName & "_COPY.iam" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Sub ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName End If Call oAssDoc.SaveAs(sNewName, False) Case Else: MsgBox "Document not an Assembly or Part.", vbCritical Exit Sub End Select 'Das Speichern kann etwas dauern. While Not oApp.ActiveDocument.FullDocumentName = sNewName Sleep 100 DoEvents Wend
Call ClearAllUserDefinediProps End Sub Private Sub ClearAllUserDefinediProps() Dim oApp As Inventor.Application Set oApp = ThisApplication Dim oDoc As Document Set oDoc = oApp.ActiveDocument Dim oPropSet As PropertySet Set oPropSet = oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") Dim oProp As Property For Each oProp In oPropSet oProp.Value = "" Next End Sub
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 10. Nov. 2020 11:46 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, Danke! Nur mal so eine Frage am Rand? wenn ich dazu eine Zeichnung habe, die muss ich von Hand kopieren und dann die Modelreferenz austausche, oder gibt es da auch einen Trick? Danke Enric ------------------ Konstruktion 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: 11. Nov. 2020 17:02 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo Der "Trick" wäre die Zeichnung und die referenzierte Baugruppe bzw. das Bauteil zu kopieren und anschließend die Modellreferenz in der neuen Zeichnung ersetzen zu lassen. Das geht auch per VBA. Der Aufwand dafür richtet sich danach, ob mehrere Blätter/Ansichten vorhanden sind. Spannender wird es, wenn z.B. eine Ansicht einer Baugruppe und in einer weiteren Ansicht ein Bauteil aus dieser Baugruppe dargestellt sind. Muss das Bauteil dann auch kopiert und in der Baugruppe ersetzt werden? Hast du solche Fälle oder immer nur ein 3D-Modell pro IDW?
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 11. Nov. 2020 19:16 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, nein, es wäre nur ein Bauteil und die dazugehörige Zeichnung und die Baugruppe mit der dazugehörigen Zeichnung. Eine Mischung gibt es nicht! Also ein 3D Modell pro IDW! MFG Enric
------------------ Konstruktion 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: 11. Nov. 2020 21:38 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo Dann probier mal den Code. Bitte beachten, die Sub heißt jetzt "CopyDrawingWithReferenceReplace", statt "SaveModelCopy". Die Buttonbilder brauchst du nur kopieren und entsprechend umbenennen. Der Makrobutton muss jetzt in die Zeichnungsumgebung eingefügt werden. Code:
Option Explicit Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Public Sub CopyDrawingWithReferenceReplace() Dim oApp As Inventor.Application Set oApp = ThisApplication If Not oApp.ActiveDocumentType = kDrawingDocumentObject Then MsgBox "aktive Zeichnung erforderlich", vbCritical Exit Sub End If Dim oDrawDoc As DrawingDocument Set oDrawDoc = oApp.ActiveDocument 'Only one referenced document is allowed If Not oDrawDoc.File.ReferencedFileDescriptors.Count = 1 Then MsgBox "Nur 1 referenziertes Modell pro Zeichnung zulässig.", vbCritical Exit Sub End If Dim sNewName As String Dim sOldName As String If Not oDrawDoc.FullFileName = "" Then sOldName = Left$(oDrawDoc.FullFileName, Len(oDrawDoc.FullFileName) - 4) End If Dim oFileDialog As Inventor.FileDialog Call oApp.CreateFileDialog(oFileDialog) oFileDialog.FilterIndex = 1 oFileDialog.CancelError = True oFileDialog.Filter = "Inventor Files (*.idw)|*.idw|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Drawing Copy" oFileDialog.FileName = sOldName & "_COPY.idw" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Sub ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName On Error GoTo 0 End If Call oDrawDoc.SaveAs(sNewName, False) Dim oRefedDoc As Document Set oRefedDoc = oDrawDoc.ReferencedDocuments.Item(1) Dim sNewModelCopyName As String sNewModelCopyName = CopyRefedDoc(oRefedDoc, sNewName) If sNewModelCopyName = "" Then MsgBox "Modell kopieren fehlgeschlagen.", vbCritical Exit Sub End If Dim oFileDesc As FileDescriptor Set oFileDesc = oDrawDoc.File.ReferencedFileDescriptors.Item(1) oFileDesc.ReplaceReference (sNewModelCopyName) End Sub Private Function CopyRefedDoc(ByVal oRefedDoc As Document, ByVal sNewName As String) As String
Dim oApp As Inventor.Application Set oApp = ThisApplication Dim sOldName As String If Not oRefedDoc.FullFileName = "" Then sOldName = Left$(oRefedDoc.FullFileName, Len(oRefedDoc.FullFileName) - 4) End If Dim oFileDialog As Inventor.FileDialog Call oApp.CreateFileDialog(oFileDialog) oFileDialog.FilterIndex = 1 oFileDialog.CancelError = True Select Case oRefedDoc.DocumentType Case kPartDocumentObject: 'MsgBox "Part" Dim oPartDoc As PartDocument Set oPartDoc = oRefedDoc oFileDialog.Filter = "Inventor Files (*.ipt)|*.ipt|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Part Copy" oFileDialog.FileName = sOldName & "_COPY.ipt" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Function ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName On Error GoTo 0 End If Call oPartDoc.SaveAs(sNewName, False) Case kAssemblyDocumentObject: 'MsgBox "Assembly" Dim oAssDoc As AssemblyDocument Set oAssDoc = oRefedDoc oFileDialog.Filter = "Inventor Files (*.iam)|*.iam|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Assembly Copy" oFileDialog.FileName = sOldName & "_COPY.iam" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Function ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName On Error GoTo 0 End If Call oAssDoc.SaveAs(sNewName, False) Case Else: MsgBox "Document not an Assembly or Part.", vbCritical CopyRefedDoc = "" Exit Function End Select 'Das Speichern kann etwas dauern. While Not oRefedDoc.FullDocumentName = sNewName Sleep 100 DoEvents Wend
Call ClearAllUserDefinediProps(oRefedDoc) CopyRefedDoc = sNewName End Function Private Sub ClearAllUserDefinediProps(ByRef oRefedDoc As Document) Dim oPropSet As PropertySet Set oPropSet = oRefedDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") Dim oProp As Property For Each oProp In oPropSet oProp.Value = "" Next End Sub
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 14. Nov. 2020 13:44 <-- editieren / zitieren --> Unities abgeben:
|
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 17. Nov. 2020 14:21 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, im letzten Abschnitt werden ja die benutzerdefinierten iProbs gelöscht! Hat man da die Möglichkeit noch, eine Zeile einzubauen, um gezielt z.B. noch die Bauteilnummer zu löschen? Schon einmal Danke für deine Hilfe. Gruß Enric ------------------ Konstruktion 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: 17. Nov. 2020 17:08 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo Ja, das geht. Code:
Option Explicit Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Sub CopyDrawingWithReferenceReplace() Dim oApp As Inventor.Application Set oApp = ThisApplication If Not oApp.ActiveDocumentType = kDrawingDocumentObject Then MsgBox "aktive Zeichnung erforderlich", vbCritical Exit Sub End If Dim oDrawDoc As DrawingDocument Set oDrawDoc = oApp.ActiveDocument 'Only one referenced document is allowed If Not oDrawDoc.File.ReferencedFileDescriptors.Count = 1 Then MsgBox "Nur 1 referenziertes Modell pro Zeichnung zulässig.", vbCritical Exit Sub End If Dim sNewName As String Dim sOldName As String If Not oDrawDoc.FullFileName = "" Then sOldName = Left$(oDrawDoc.FullFileName, Len(oDrawDoc.FullFileName) - 4) End If Dim oFileDialog As Inventor.FileDialog Call oApp.CreateFileDialog(oFileDialog) oFileDialog.FilterIndex = 1 oFileDialog.CancelError = True oFileDialog.Filter = "Inventor Files (*.idw)|*.idw|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Drawing Copy" oFileDialog.FileName = sOldName & "_COPY.idw" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Sub ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName On Error GoTo 0 End If Call oDrawDoc.SaveAs(sNewName, False) Dim oRefedDoc As Document Set oRefedDoc = oDrawDoc.ReferencedDocuments.Item(1) Dim sNewModelCopyName As String sNewModelCopyName = CopyRefedDoc(oRefedDoc, sNewName) If sNewModelCopyName = "" Then MsgBox "Modell kopieren fehlgeschlagen.", vbCritical Exit Sub End If Dim oFileDesc As FileDescriptor Set oFileDesc = oDrawDoc.File.ReferencedFileDescriptors.Item(1) oFileDesc.ReplaceReference (sNewModelCopyName) End Sub Private Function CopyRefedDoc(ByVal oRefedDoc As Document, ByVal sNewName As String) As String
Dim oApp As Inventor.Application Set oApp = ThisApplication Dim sOldName As String If Not oRefedDoc.FullFileName = "" Then sOldName = Left$(oRefedDoc.FullFileName, Len(oRefedDoc.FullFileName) - 4) End If Dim oFileDialog As Inventor.FileDialog Call oApp.CreateFileDialog(oFileDialog) oFileDialog.FilterIndex = 1 oFileDialog.CancelError = True Select Case oRefedDoc.DocumentType Case kPartDocumentObject: 'MsgBox "Part" Dim oPartDoc As PartDocument Set oPartDoc = oRefedDoc oFileDialog.Filter = "Inventor Files (*.ipt)|*.ipt|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Part Copy" oFileDialog.FileName = sOldName & "_COPY.ipt" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Function ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName On Error GoTo 0 End If Call oPartDoc.SaveAs(sNewName, False) Case kAssemblyDocumentObject: 'MsgBox "Assembly" Dim oAssDoc As AssemblyDocument Set oAssDoc = oRefedDoc oFileDialog.Filter = "Inventor Files (*.iam)|*.iam|All Files (*.*)|*.*" oFileDialog.DialogTitle = "Save Assembly Copy" oFileDialog.FileName = sOldName & "_COPY.iam" On Error Resume Next oFileDialog.ShowSave If Err Then Exit Function ElseIf oFileDialog.FileName <> "" Then sNewName = oFileDialog.FileName On Error GoTo 0 End If Call oAssDoc.SaveAs(sNewName, False) Case Else: MsgBox "Document not an Assembly or Part.", vbCritical CopyRefedDoc = "" Exit Function End Select 'Das Speichern kann etwas dauern. While Not oRefedDoc.FullDocumentName = sNewName Sleep 100 DoEvents Wend Call ClearAllUserDefinediProps(oRefedDoc) Call ClearPartNumberProp(oRefedDoc)
CopyRefedDoc = sNewName End Function Private Sub ClearAllUserDefinediProps(ByRef oRefedDoc As Document) Dim oPropSet As PropertySet Set oPropSet = oRefedDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") Dim oProp As Property For Each oProp In oPropSet oProp.Value = "" Next End Sub Private Function ClearPartNumberProp(ByRef oRefedDoc As Document) Dim oPropSet As PropertySet Set oPropSet = oRefedDoc.PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}") Dim oProp As Property For Each oProp In oPropSet If oProp.Name = "Part Number" Then oProp.Value = "" End If Next End Function
------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 19. Nov. 2020 16:15 <-- editieren / zitieren --> Unities abgeben:
|
EIBe 3D Mitglied Dipl. - Ing. (FH)
Beiträge: 267 Registriert: 24.01.2020 HP Z4 G4 Workstation Xeon 3,6 32GB Nvidia P2000 WIN10 SW2015 SP5.0 SW2017 ************* Inv2018 akt.SP
|
erstellt am: 20. Nov. 2020 07:08 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo zusammen, @ralf: in der folgenden Zeile Code hast du eine Schleife eingebaut, welche das erfolgreiche Speichern abfragt. Code: 'Das Speichern kann etwas dauern. While Not oRefedDoc.FullDocumentName = sNewName Sleep 100 DoEvents Wend
Dazu habe ich zwei Fragen. 1. Du hast keine zweite Abbruchbedingung definiert. Was würde passieren wenn das Speichern, z.B. auf einem Server fehlschlägt? In solchen Fälle baue ich einen Zähler ein, welcher wenn erreicht aus der Schleife aussteigt. So verhindere ich in einer Endlosschleife gefangen zu sein. 2. In der Prüfschleife verwendest du Sleep. Soweit ich weiß legt Sleep die gesamte Prozedur lahm. Hat Sleep keinen Einfluss auf den Speichervorgang in Inventor, sprich wird dieser ununterbrochen fortgeführt trotz Sleep in der aufrufenden Prozedur? Grüße
EIBe 3D Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Enric Mitglied Ingenieurbüro
Beiträge: 231 Registriert: 29.02.2008 Einsatz: Inventor 2018
|
erstellt am: 20. Nov. 2020 10:45 <-- editieren / zitieren --> Unities abgeben:
Hallo Ralf, ich habe da noch mal eine Frage:" Wenn ich eine Baugruppe aufhabe, und nur ein Teil aus dieser Baugruppe benötige, tauscht der mir das Teil auch in der Baugruppe aus!" Die Baugruppe müsste ich schließen, erst dann könnte ich die Prozedur starten. Wie kann den das abgefangen werden? VG Enric ------------------ Konstruktion Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 20. Nov. 2020 11:20 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
@EIBe 3D bin sicher kein Experte in derartigen Details (außerdem nicht angesprochen), trotzdem lasse ich mich etwas aus. Das vorab als Warnung. mE läuft VBA synchron mit Inventor, es unterstützt auch kein multithreading. (IV selbst nutzt aber für immer mehr Aufgaben multithreading, also schaut es z.B. beim Arbeiten mit Ansichten in Zeichnungen ggf. anders aus.) Hier beim .SaveAs wird dieser Schritt erst abgeschlossen bevor die nächste Zeilen abgearbeitet werden. In einem kleinen Test, habe ich a) einen Zähler in die Schleife gesetzt und b) mir drei Zeitpunkte gemerkt (vor und nach dem Speicher und nach der Schleife; mit Timer(). ) Zum Test habe ich eine große ipt mit 270 MB verwendet. Lokal gespeichert. Ergebnis: a) der Zähler bleibt 0 (Schleife wird nicht durchlaufen) b) das Speichern selbst dauerste grob 60 s; die Zeitspanne über die Schleife war nicht auflösbar (sehr kurz) zu Deinen Fragen: 1. Da könntest Du recht haben. So eine Sicherung wäre wohl gut, aber evtl. auch nicht ganz einfach den Zeitpunkt fest zu legen. 2. Sleep legt "nur" den Thread lahm, in dem VBA läuft. Bei einer Multithreading-Aktion würden die anderen Threads weiter laufen. Wäre mE also kein Problem. ------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 20. Nov. 2020 11:48 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Zitat: Original erstellt von Enric: " Wenn ich eine Baugruppe aufhabe, und nur ein Teil aus dieser Baugruppe benötige, tauscht der mir das Teil auch in der Baugruppe aus!" Die Baugruppe müsste ich schließen, erst dann könnte ich die Prozedur starten. Wie kann den das abgefangen werden?
ohne es getestet zu haben: In der Function CopyRefedDoc(...) bei den beiden .SaveAs Call oPartDoc.SaveAs(sNewName, False) Call oAssDoc.SaveAs(sNewName, False) jeweils das False durch True ersetzen Call oPartDoc.SaveAs(sNewName, True) Call oAssDoc.SaveAs(sNewName, True) Dadurch wird eine Kopie gespeichert, es bleibt aber das Original geöffnet. ------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KraBBy Mitglied Maschinenbau-Ingenieur
Beiträge: 601 Registriert: 19.09.2007 Inventor Professional 2020 WinX
|
erstellt am: 20. Nov. 2020 12:01 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
sorry, so einfach dann doch nicht. In der Function CopyRefedDoc() ist noch etwas mehr zu tun. Code:
' [...] End SelectDim oNewDoc as Document set oNewDoc = ThisApplication.Documents.Open(sNewName, False) 'Kopie öffnen (Visible=False) 'Das Speichern kann etwas dauern. 'diesen Block auskommentiert 'While Not oRefedDoc.FullDocumentName = sNewName ' Sleep 100 ' DoEvents 'Wend Call ClearAllUserDefinediProps(oNewDoc) 'diese Subs auf die Kopie anwenden Call ClearPartNumberProp(oNewDoc) oNewDoc.ReleaseReference 'weil unsichtbar geöffnet, sonst bleibts ewig offen CopyRefedDoc = sNewName End Function
------------------ Gruß KraBBy Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
EIBe 3D Mitglied Dipl. - Ing. (FH)
Beiträge: 267 Registriert: 24.01.2020 HP Z4 G4 Workstation Xeon 3,6 32GB Nvidia P2000 WIN10 SW2015 SP5.0 SW2017 ************* Inv2018 akt.SP
|
erstellt am: 20. Nov. 2020 12:37 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo KraBBy, danke für das auslassen und testen. Leider läuft VBA nicht immer ganz synchron mit Inventor bzw. desen Add-Ins. Im Fall des Speicherns anscheinend doch, sonst wäre er ja in die Schleife eingestiegen. Ich habe die Erfahrung gemacht, dass Sleep nicht den gewünschten Erfolg in einer Schleife zur Verzögerung bringt. Lange Zeitspannnen in einer Schleife abzubilden ist natürlich etwas aufwändiger schwieriger, sollte aber zum Bsp über eine Abfrage der Systemzeit gehen. Anbei noch ein Schnippsel mit doppelter Schleife um größere zeitspannen abzudecken. Vielleicht nicht besonders elegant, aber erfüllt seine Funktion. Code: Dim oDrwDoc As DrawingDocument: Set oDrwDoc = oDoc Dim oSheet As Sheet: Set oSheet = oDrwDoc.ActiveSheetDim iCount As Integer iAbbrCount = 0 'Führt Schleife aus bis Vorgang Stückliste einfügen durchgeführt, beendet Programm nach 10000 Schleifendurchläufen Warten: iAbbrCount = iAbbrCount + 1 If iAbbrCount = 10000 Then 'Abbruchbedingung um MsgBox "Einfügen der Stückliste fehlgeschlagen." & vbCr & vbCr & "Das Makro wird nun beendet.", vbExclamation, sDialogTitle01 Exit Sub End If 'Unterschleife zur Prüfung ob Stückliste eingefügt wurde, verhindert u.A. Überlauf falls Abbruchbedingung zu hoch gewählt wird Do While oSheet.PartsLists.Count = 0 And iCount < 20000 Set oSheet = oDrwDoc.ActiveSheet DoEvents iCount = iCount + 1 Loop 'Positioniert Stückliste wenn vorhanden, wenn nicht springt zu Warten Schleife If oSheet.PartsLists.Count > 0 Then Call BOM_ausrichten Else: GoTo Warten End If
der Code soll nach dem Einfügen einer Stückliste aus dem PDM System diese über dem Schriftfeld ausrichten. Geht natürlich nur wenn diese auf dem Blatt vorhanden ist. Möchte aber den Thread hier auch nicht kapern, daher schonmal sorry. Ergab sich nur aus meiner Nachfrage. Grüße
EIBe 3D 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: 20. Nov. 2020 18:35 <-- editieren / zitieren --> Unities abgeben: Nur für Enric
Hallo Man kann die Schleife weglassen. Inventor setzt den Code erst nach dem Speichern fort. Da war ich im Irrtum. Egal ob mit Zählvariablen oder einer Systemzeit, solange ich nicht weiß wie lange ein Vorgang dauern wird, warte ich entweder viel zu lange oder breche kurz vor Fertigstellung ab. Beides macht nur bei halbwegs vorhersehbarer Dauer Sinn. Bei deiner Teilelistenpositionierung würde ich das besser über einen Eventhandler lösen. Dafür wäre z.B. das TransactionEvent.OnCommit mit kAfter und TransactionObject: Bauteilliste erstellen (Transaction) perfekt. Inventor sagt dir Bescheid, dass die Bauteilliste fertig ist und du sie zurechtschubsen kannst. Wenn du das Einfügen aus dem PDM nicht über dein Makro startest, hast du nur das Problem irgendwann vorher in der Inventorsitzung den Eventhandler zu verbinden. Deswegen nehme ich dann lieber AddIns. Da kann ich das beim Laden/Aktivieren erledigen. Deine Schleifen dürfte einen Prozessorkern voll auslasten. Zu meiner Jugendzeit hat man damit den ganzen Rechner zum Stillstand gebracht und den CPU-Lüfter mal mit Maximaldrehzahl entstaubt . ------------------ MfG Ralf RKW Solutions GmbH www.RKW-Solutions.com Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |