Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  speichern unter und Benutzer iProbs löschen

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
Autor Thema:   speichern unter und Benutzer iProbs löschen (582 mal gelesen)
Enric
Mitglied
Ingenieurbüro


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 02. Nov. 2020 17:22    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 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


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

Beiträge: 340
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 02. Nov. 2020 22:01    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 Enric 10 Unities + Antwort hilfreich

Das mit den Bildern die die Benutzer Oberfläche ist falsch (oder ich verstehe nicht richtig, was es werden soll)

help benutzerbefehle

Es ist kein Code dazu nötig. Es kommt nur auf den Speicherort und Dateiname an. Siehe verlinkter Hilfe Eintrag.

------------------
Gruß KraBBy

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: 1676
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 03. Nov. 2020 10:48    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 03. Nov. 2020 18:05    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 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


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: 1676
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 03. Nov. 2020 21:34    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 340
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 04. Nov. 2020 12:53    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 04. Nov. 2020 15:24    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,

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


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

Beiträge: 340
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 04. Nov. 2020 16:27    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 10. Nov. 2020 07:22    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,

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 10. Nov. 2020 07:23    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,

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


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: 1676
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 10. Nov. 2020 08:44    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 10. Nov. 2020 11:46    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!

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


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: 1676
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 11. Nov. 2020 17:02    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 11. Nov. 2020 19:16    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,

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


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: 1676
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 11. Nov. 2020 21:38    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 14. Nov. 2020 13:44    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 deine Unterstützung!
Blei in den Zeiten gesund!

VG
Enric

------------------
Konstruktion

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

Enric
Mitglied
Ingenieurbüro


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 17. Nov. 2020 14: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,

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


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: 1676
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 17. Nov. 2020 17:08    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 19. Nov. 2020 16:15    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 deine Unterstützung!

VG
Enric

------------------
Konstruktion

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


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

Beiträge: 118
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 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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 200
Registriert: 29.02.2008

Einsatz: Inventor 2018

erstellt am: 20. Nov. 2020 10:45    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,

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


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

Beiträge: 340
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 20. Nov. 2020 11:20    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 Enric 10 Unities + Antwort hilfreich

@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


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

Beiträge: 340
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 20. Nov. 2020 11:48    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 Enric 10 Unities + Antwort hilfreich

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


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

Beiträge: 340
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 20. Nov. 2020 12:01    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 Enric 10 Unities + Antwort hilfreich

sorry, so einfach dann doch nicht.
In der Function CopyRefedDoc() ist noch etwas mehr zu tun.
Code:

' [...]
End Select

Dim 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)


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

Beiträge: 118
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 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 Enric 10 Unities + Antwort hilfreich

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.ActiveSheet

Dim 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


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: 1676
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 20. Nov. 2020 18:35    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 Enric 10 Unities + Antwort hilfreich

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

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)2020 CAD.de | Impressum | Datenschutz