Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Auflösung/Größe Thumbnail

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:  Auflösung/Größe Thumbnail (1081 mal gelesen)
HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 23. Nov. 2021 10: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

Hallo,

brauche nochmal Hilfe. Gibt es eine Möglichkeit die Größe/Auflösung der Vorschaubilder beim Stücklistenexport der .iam nach Excel zu ändern?
Wir verwenden IV2021 und würden die Vorschaubilder auch für das ERP verwenden. Leider sind die Bilder aber sehr klein mit geringer Auflösung.
Vielen Dank inzwischen...
Hans Peter

------------------
Beste Grüße
Hans Peter

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: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 24. Nov. 2021 17:31    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 HansPeterNew 10 Unities + Antwort hilfreich

Damit habe ich mich bisher noch nicht befasst. Ich konnte jetzt in der API-Hilfe keine Option dazu finden.
Bild selber erstellen?

Camera.SaveAsBitmap Method

Camera.CreateImage Method
das wäre ein Bild im Arbeitsspeicher, ohne eine Datei zu erzeugen. kA wie man das ins Excel wirft

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

Windows 10 x64, AIP 2022

erstellt am: 24. Nov. 2021 23:29    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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Das Thumbnail ist nicht veränderlich. Bleiben die Bilder in der Exceltabelle oder wo liegen die Bilder, damit das ERP darauf zugreifen kann? Werden die Bilder in der Datenbank des ERP gespeichert oder liegen die extern auf einem Share? Wie wird die Stückliste übergeben? Ist das ein Script in dem man etwas ergänzen oder dazwischen springen kann?

So in etwa sollte das funktionieren. Ist iLogic, kann man aber auch in VBA übersetzen.

Code:

Option Explicit on
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = ThisDoc.Document
Dim sFilename As String = ThisDoc.FileName(False)
Dim oTrans As Transaction= oApp.TransactionManager.StartTransaction(oDoc, "PicEX ")
Dim oCurView As View= oApp.ActiveView

Try
oApp.ScreenUpdating = False
Dim oView As View= oDoc.Views.Add()
Dim oCamera As Camera= oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap("C:\Temp\" & sFilename & ".jpg", 1920, 1080, oColor)

oView.Close
oCurView.Activate
Catch
Finally
oTrans.Abort
oApp.ScreenUpdating = True

oDoc.Update
End Try



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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 25. Nov. 2021 09: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

Zitat:
Original erstellt von rkauskh:
Hallo

Das Thumbnail ist nicht veränderlich. Bleiben die Bilder in der Exceltabelle oder wo liegen die Bilder, damit das ERP darauf zugreifen kann? Werden die Bilder in der Datenbank des ERP gespeichert oder liegen die extern auf einem Share? Wie wird die Stückliste übergeben? Ist das ein Script in dem man etwas ergänzen oder dazwischen springen kann?

So in etwa sollte das funktionieren. Ist iLogic, kann man aber auch in VBA übersetzen.

Code:

Option Explicit on
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = ThisDoc.Document
Dim sFilename As String = ThisDoc.FileName(False)
Dim oTrans As Transaction= oApp.TransactionManager.StartTransaction(oDoc, "PicEX ")
Dim oCurView As View= oApp.ActiveView

Try
oApp.ScreenUpdating = False
Dim oView As View= oDoc.Views.Add()
Dim oCamera As Camera= oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap("C:\Temp\" & sFilename & ".jpg", 1920, 1080, oColor)

oView.Close
oCurView.Activate
Catch
Finally
oTrans.Abort
oApp.ScreenUpdating = True

oDoc.Update
End Try




Hallo Ralf,

ich schon wieder.
vielen Dank. Damit können wir super arbeiten.
Hab den Pfad noch dazugenommen.
Leider kommt nach einer Änderung beim Ausführen ein Fehler.
Auch bei deiner Regel funkt das beim 2. mal ausführen nach einer Änderung nicht. (Hab es bei einer Baugruppe verucht)
Kannst du mir da helfen?

Option Explicit on
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = ThisDoc.Document
Dim sFilename As String = ThisDoc.PathAndFileName(False)
Dim oTrans As Transaction= oApp.TransactionManager.StartTransaction(oDoc, "PicEX ")
Dim oCurView As View= oApp.ActiveView
Try
oApp.ScreenUpdating = False
Dim oView As View= oDoc.Views.Add()
Dim oCamera As Camera= oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color = oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sFilename & ".jpg", 1920, 1080, oColor)


oView.Close
oCurView.Activate
Catch
Finally
oTrans.Abort
oApp.ScreenUpdating = True

oDoc.Update
End Try

------------------
Beste Grüße
Hans Peter

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 25. Nov. 2021 11:31    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


Screenshot2021-11-25112924.jpg


Screenshot2021-11-25113009.jpg

 
Hallo Ralf,

hier noch meine Fehlermeldungen.
Hans Peter

------------------
Beste Grüße
Hans Peter

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: 25. Nov. 2021 15: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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Ergänze mal bitte die Catch Anweisung was in der Fehlermeldung dann drin steht. Was wurde wie geändert? Hab jetzt einige Varianten durchprobiert ohne Fehler. Läuft der Code über einen Trigger (welcher?) oder manuell ausgelöst? Wenn nach dem ersten Durchlauf das Bild manuell gelöscht wird, kommt der Fehler dann trotzdem?

Code:

Option Explicit on
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = ThisDoc.Document
Dim sFilename As String = ThisDoc.PathAndFileName(False)
Dim oTrans As Transaction= oApp.TransactionManager.StartTransaction(oDoc, "PicEX ")
Dim oCurView As View= oApp.ActiveView

Try
oApp.ScreenUpdating = False
Dim oView As View= oDoc.Views.Add()
Dim oCamera As Camera= oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sFilename & ".jpg", 1920, 1080, oColor)

oView.Close
oCurView.Activate
Catch ex As Exception
MsgBox(ex.Message)
Finally
oTrans.Abort
oApp.ScreenUpdating = True

oDoc.Update
End Try


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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 25. Nov. 2021 15:33    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,

Code:

Option Explicit on
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = ThisDoc.Document
Dim sFilename As String = ThisDoc.PathAndFileName(True)
Dim oTrans As Transaction= oApp.TransactionManager.StartTransaction(oDoc, "PicEX ")
Dim oCurView As View= oApp.ActiveView
Try
oApp.ScreenUpdating = False
Dim oView As View= oDoc.Views.Add()
Dim oCamera As Camera= oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color = oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sFilename & ".jpg", 1920, 1080, oColor)


oView.Close
oCurView.Activate
Catch ex As Exception
MsgBox(ex.Message)
Finally
oTrans.Abort
oApp.ScreenUpdating = True

oDoc.Update
End Try


Ich hab eigentlich nur Zeile 4
Dim sFilename As String = ThisDoc.PathAndFileName(True)
und Zeile 17 geändert
Call oCamera.SaveAsBitmap(sFilename & ".jpg", 1920, 1080, oColor)

Funktioniert auch soweit super.
Der Code läuft vor dem Speichern von Dokument.
Der Fehler taucht nur auf, sobald ich ein Teil in der Baugruppe lösche und nochmal speichern möchte.
Dann stürzt IV komplett ab.

------------------
Beste Grüße
Hans Peter

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: 25. Nov. 2021 20:43    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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Warum genau er da den Transactionsabbruch nicht mag weiß ich grade auch nicht. Geht aber auch ohne. Mit der Variante tritt der Fehler nicht mehr auf.

Code:

Option Explicit on
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = ThisDoc.Document
Dim sFilename As String = ThisDoc.PathAndFileName(False)
Dim oCurView As Inventor.View= oApp.ActiveView

Try
oApp.ScreenUpdating = False
Dim oView As Inventor.View = oDoc.Views.Add()
oView.Visible = False

Dim oCamera As Camera = oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sFilename & ".jpg", 1920, 1080, oColor)

oView.Close
Catch ex As Exception
MsgBox(ex.Message)
Finally
oApp.ScreenUpdating = True
End Try


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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 26. Nov. 2021 11:13    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 hab die Regel jetzt in die Vorlage für Blech und Normbauteil kopiert.
Jetzt kommt wieder ein Fehler beim Speichern.
     

------------------
Beste Grüße
Hans Peter

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 26. Nov. 2021 15:41    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,

habs inzwischen selber gelöst.
Den Trigger nach dem Speichern gesetzt und gepasst.
Vielen Dank für die kompetente und schnelle Hilfe.

------------------
Beste Grüße
Hans Peter

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: 26. Nov. 2021 16: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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Wenn das in einer Vorlage steckt und du das erste Mal speicherst, vermute ich das ThisDoc.PathAndFileName noch leer ist. Das wird ja intern wahrscheinlich vom Document.FullFilename abgeleitet. Du könntest prüfen, ob der leer ist. Dann müßte man schauen ob und wie man alternativ den Pfad und Dateinamen für den Export generiert.
Das wäre wieder ein Vorteil eines Addins. Dort kann man aus dem Context des OnSave Events unter anderem den FullFileName auslesen, in den das Dokument gespeichert werden soll.

Aber wenn es mit "Nach dem Speichern" funktioniert, einfach lassen und nicht rumfummeln. 

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 29. Nov. 2021 16:13    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 2 externe Regeln für einen stp export mit MBD und eben die Bilder aktiv.
Es ist jetzt doch nicht ganz so einfach. Beim Befehl speichern unter werden die Dateien (stp und Bild) vom ursprünglichen Teil überschrieben und vom neuen Teil wird nichts erstellt.
Hast du vielleicht eine Idee wie ich das lösen könnte?

Code:

' Get the STEP translator Add-In.
Dim sPath As String = ThisDoc.Path
Dim sFile As String = ThisDoc.FileName (True)
Dim oSTEPTranslator As TranslatorAddIn
oSTEPTranslator = ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext
oContext = ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap
oOptions = ThisApplication.TransientObjects.CreateNameValueMap

If oSTEPTranslator.HasSaveCopyAsOptions(ThisDoc.Document, oContext, oOptions) Then
' Set application protocol.
' 2 = AP 203 - Configuration Controlled Design
' 3 = AP 214 - Automotive Design
oOptions.Value("ApplicationProtocolType") = 5
' Other options...
'oOptions.Value("Author") = ""
'oOptions.Value("Authorization") = ""
'oOptions.Value("Description") = ""
'oOptions.Value("Organization") = ""
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oData As DataMedium
oData = ThisApplication.TransientObjects.CreateDataMedium
oData.FileName = sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".stp"
oSTEPTranslator.SaveCopyAs(ThisDoc.Document, oContext, oOptions, oData)
End If


und eben

Code:

Option Explicit On
Dim oApp As Inventor.Application = ThisApplication
Dim oDoc As Document = ThisDoc.Document
'Dim sFilename As String = ThisDoc.PathAndFileName(True)
Dim sPath As String = ThisDoc.Path
Dim sFile As String = ThisDoc.FileName (True)
Dim oCurView As Inventor.View= oApp.ActiveView
Try
oApp.ScreenUpdating = False
Dim oView As Inventor.View = oDoc.Views.Add()
oView.Visible = False

Dim oCamera As Camera = oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".jpg", 1920, 1080, oColor)

oView.Close
Catch ex As Exception
MsgBox(ex.Message)
Finally
oApp.ScreenUpdating = True
End Try


Danke inzwischen und Grüße

------------------
Beste Grüße
Hans Peter

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. Nov. 2021 21: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 Nur für HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Doch, ist einfach (zu erklären). Das OnSave-Event wird im Originaldokument ausgelöst. In dessen Kontext läuft dann auch die Regel, daher ist ThisDoc das Original. Das dann eine Kopie mit neuem Namen gespeichert wird, ändert daran nichts. Die Unterscheidung und angepasste Reaktion ermöglicht der iLogic Eventhandler nicht. Dort fehlen die notwendigen Kontextinfos.

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 30. Nov. 2021 07: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

Hallo Ralf,

vielen Dank.
Ein weiteres Problem ist jetzt aufgetaucht:
beim benutzerdefinierten einfügen von Inhaltcenter-Dateien stürzt IV bei der Bild Regel ab. Die stp-Regel läuft durch.
Kannst du mir da nochmal helfen?
Danke

------------------
Beste Grüße
Hans Peter

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 01. Dez. 2021 15:59    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,

hab jetzt einen anderen Ansatz der für mich noch besser passen würde.
Die 2 Regeln in einer übergeordneten Baugruppe manuell starten für alle Teile der Unterbaugruppe durchlaufen lassen.
Mein Versuch mit diesem Code den ich auch im Forum gefunden habe ist kläglich gescheitert.
Bitte nochmal um eure Hilfe!!

Code:

Dim asmDoc As AssemblyDocument = ThisApplication.ActiveDocument
Dim tmpDoc As Document
For Each tmpDoc In asmDoc.AllReferencedDocuments  ' liefert Alle untergeordneten Elemente, inkl. Komp. aus Unterbgr.
'For Each tmpDoc In asmDoc.ReferencedDocuments    ' liefert nur die Komponenten der aktiven Bgr.; oberste Ebene
    If TypeOf tmpDoc Is AssemblyDocument then
        '...
    ElseIf tmpDoc.ComponentDefinition.IsContentMember then
        '...
    Else
        '...
    End If
Next

Danke

------------------
Beste Grüße
Hans Peter

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: 01. Dez. 2021 21:17    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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Der Absturz tritt im 2022er nicht mehr auf. Hilft dir aktuell aber sicher auch nicht weiter. Ich habe einige Konstellationen durchprobiert, aber keine hat stabil funktioniert.

Du kannst deine beiden Regeln beispielsweise in eigene Prozeduren kapseln und sie in deiner Schleife aus einer übergeordneten Prozedur aufrufen. Das jeweilige Document übergibst du als Argument. Das macht es etwas übersichtlicher.

Code:

Private Sub Main
Dim asmDoc As AssemblyDocument = ThisDoc.Document
Dim tmpDoc As Document
For Each tmpDoc In asmDoc.AllReferencedDocuments  ' liefert Alle untergeordneten Elemente, inkl. Komp. aus Unterbgr.
'For Each tmpDoc In asmDoc.ReferencedDocuments    ' liefert nur die Komponenten der aktiven Bgr.; oberste Ebene
    If TypeOf tmpDoc Is AssemblyDocument Then
        '...
    ElseIf tmpDoc.ComponentDefinition.IsContentMember Then
        '...
    Else
        '...
SaveAsImage(tmpDoc)
SaveAsSTEP(tmpDoc)
    End If
Next

End Sub

Private Sub SaveAsSTEP(ByVal oDoc As Document)
' Get the STEP translator Add-In.
Dim sPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
Dim oSTEPTranslator As TranslatorAddIn= ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext= ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap= ThisApplication.TransientObjects.CreateNameValueMap

If oSTEPTranslator.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
' Set application protocol.
' 2 = AP 203 - Configuration Controlled Design
' 3 = AP 214 - Automotive Design
oOptions.Value("ApplicationProtocolType") = 5
' Other options...
'oOptions.Value("Author") = ""
'oOptions.Value("Authorization") = ""
'oOptions.Value("Description") = ""
'oOptions.Value("Organization") = ""
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
oData.FileName = sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".stp"
oSTEPTranslator.SaveCopyAs(oDoc, oContext, oOptions, oData)
End If
End Sub

Private Sub SaveAsImage(ByVal oDoc As Document)
Dim oApp As Inventor.Application = ThisApplication

'Dim sFilename As String = ThisDoc.PathAndFileName(True)
Dim sPath As String =  System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
Dim oCurView As Inventor.View= oApp.ActiveView
Try
oApp.ScreenUpdating = False
Dim oView As Inventor.View = oDoc.Views.Add()
oView.Visible = False

Dim oCamera As Camera = oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".jpg", 1920, 1080, oColor)

oView.Close
Catch ex As Exception
MsgBox(ex.Message)
Finally
oApp.ScreenUpdating = True
End Try
End Sub


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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 06. Dez. 2021 09:09    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

Vielen, vielen Dank.
Bin super happy.

------------------
Beste Grüße
Hans Peter

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 28. Feb. 2022 17:33    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 möchte jetzt auch die Abwicklungen der Blechteile automatisch abspeichern und ein 3D pdf erstellen. Bis zum Bild funktioniert alles. Es kommt aber schon beim 1. dxf ein Ausnahmefehler.

Was hab ich falsch?

Code:
Private Sub Main
Dim asmDoc As AssemblyDocument = ThisDoc.Document
Dim tmpDoc As Document
For Each tmpDoc In asmDoc.AllReferencedDocuments  ' liefert Alle untergeordneten Elemente, inkl. Komp. aus Unterbgr.
    If TypeOf tmpDoc Is AssemblyDocument Then
SaveAsImage(tmpDoc)
SaveAsSTEP(tmpDoc)
    ElseIf tmpDoc.ComponentDefinition.IsContentMember Then
        '...
    Else
        '...
SaveAsImage(tmpDoc)
SaveAsSTEP(tmpDoc)
SaveAsdxf(tmpDoc)
    End If
Next

'Dim oDoc As AssemblyDocument = ThisDoc.Document
'Dim tmpDoc As Document
Dim sPath As String = System.IO.Path.GetDirectoryName(asmDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileNameWithoutExtension(asmDoc.FullFileName)
ThisBOM.Export(“Structured”, sPath & "\PDM_IMPORT\" & sFile & ".csv", kTextFileCommaDelimitedFormat)
End Sub

Private Sub SaveAsSTEP(ByVal oDoc As Document)
' Get the STEP translator Add-In.
Dim sPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileName(oDoc.FullFileName)
Dim oSTEPTranslator As TranslatorAddIn= ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext= ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap= ThisApplication.TransientObjects.CreateNameValueMap

If oSTEPTranslator.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
' Set application protocol.
' 2 = AP 203 - Configuration Controlled Design
' 3 = AP 214 - Automotive Design
oOptions.Value("ApplicationProtocolType") = 5
' Other options...
'oOptions.Value("Author") = ""
'oOptions.Value("Authorization") = ""
'oOptions.Value("Description") = ""
'oOptions.Value("Organization") = ""
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
oData.FileName = sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".stp"
oSTEPTranslator.SaveCopyAs(oDoc, oContext, oOptions, oData)
End If
End Sub

Private Sub SaveAsImage(ByVal oDoc As Document)
Dim oApp As Inventor.Application = ThisApplication

'Dim sFilename As String = ThisDoc.PathAndFileName(True)
Dim sPath As String =  System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileName(oDoc.FullFileName)
Dim oCurView As Inventor.View= oApp.ActiveView
Try
oApp.ScreenUpdating = False
Dim oView As Inventor.View = oDoc.Views.Add()
oView.Visible = False

Dim oCamera As Camera = oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".jpg", 1920, 1080, oColor)

oView.Close
Catch ex As Exception
MsgBox(ex.Message)
Finally
oApp.ScreenUpdating = True
End Try
End Sub

Private Sub SaveAsdxf(ByVal oDoc As Document)

'oDoc = ThisApplication.ActiveDocument
Dim sPath As String =  System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileName(oDoc.FullFileName)
   
    'Prüfen ob Datei ein Blech ist und falls keine Abwicklnug vorhanden Abwicklung erstellen
  If oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
          oFlatPattern = oDoc.ComponentDefinition.FlatPattern
          oSheetMetalCompDef = oDoc.ComponentDefinition
          If oSheetMetalCompDef.HasFlatPattern = False Then oSheetMetalCompDef.Unfold
  Else
        'Abbrechen, wenn kein Blechbauteil
      Exit Sub
  End If
   
    'Dateiname ohne Extension ermitteln und Exporterweiterung anhängen
    'Dim Dateiname As String
    'Dateiname = Left(oDoc.FullFileName, Len(oDoc.FullFileName) - 3) & Ext
   
    'Export der Abwicklung durchführen
    Dim sOut As String
sOut = "FLAT PATTERN DXF?AcadVersion=2004&OuterProfileLayer=IV_OUTER_PROFILE&Interi​orProfilesLayer=IV_INTERIOR_PROFILES&InvisibleLayers=IV_FEATURE_PROFILES_DOWN;IV_TANGENT;IV_BEND;IV_BEND_DOWN;I  V_FEATURE_PROFILES;IV_FEATURE_PROFILES&OuterProfileLayerColor=255,0,0"

Dim sFname As String
sFname = sPath & "\PDM_IMPORT\" & sFile & "\Abwicklung\" & sFile & ".dxf"
oSheetMetalCompDef.DataIO.WriteDataToFile( sOut, sFname)
'oDoc = ThisApplication.ActiveDocument
Dim oSMDef As SheetMetalComponentDefinition
oSMDef = oDoc.ComponentDefinition
oSMDef.FlatPattern.ExitEdit
End Sub


------------------
Beste Grüße
Hans Peter

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: 28. Feb. 2022 20:36    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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

1. In deinem String sOut sind Leerzeichen enthalten, die da nicht sein dürften.
2. WriteDataToFile geht davon aus, dass der Pfad existiert. Ansonsten gibt es einen Fehler. Also vorher prüfen und ggf. anlegen (System.IO.Directory.CreateDirectory).

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 01. Mrz. 2022 18: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

Haha super,
das geht jetzt top.
Jetzt noch die Abmessungen der Abwicklung in einem Benutzerdefinierten I-Prop schreiben. Hab das auch hier aus dem Netz, das will aber nicht.
Ich bastel mich so durch...    
Kannst du auf den Code ganz zum Schluss bitte einen Blick werfen?
Läuft zwar ohne Fehler, aber ich bekomme keine Benutzerdefinierte Iprops

(Ich möchte das gern so machen, weil wir die Abwicklung manchmal bearbeiten und so die Blechdicke von der Dicke der Abwicklung abweicht

Code:

Private Sub Main
Dim asmDoc As AssemblyDocument = ThisDoc.Document
Dim tmpDoc As Document
For Each tmpDoc In asmDoc.AllReferencedDocuments  ' liefert Alle untergeordneten Elemente, inkl. Komp. aus Unterbgr.
    If TypeOf tmpDoc Is AssemblyDocument Then
SaveAsImage(tmpDoc)
SaveAsSTEP(tmpDoc)
    ElseIf tmpDoc.ComponentDefinition.IsContentMember Then
        '...
    Else
        '...
SaveAsImage(tmpDoc)
SaveAsSTEP(tmpDoc)
SaveAsdxf(tmpDoc)
    End If
Next

'Dim oDoc As AssemblyDocument = ThisDoc.Document
'Dim tmpDoc As Document
Dim sPath As String = System.IO.Path.GetDirectoryName(asmDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileNameWithoutExtension(asmDoc.FullFileName)
System.IO.Directory.CreateDirectory (sPath & "\PDM_IMPORT\")
ThisBOM.Export(“Structured”, sPath & "\PDM_IMPORT\" & sFile & ".csv", kTextFileCommaDelimitedFormat)
End Sub

Private Sub SaveAsSTEP(ByVal oDoc As Document)
' Get the STEP translator Add-In.
Dim sPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileName(oDoc.FullFileName)
Dim oSTEPTranslator As TranslatorAddIn= ThisApplication.ApplicationAddIns.ItemById("{90AF7F40-0C01-11D5-8E83-0010B541CD80}")
Dim oContext As TranslationContext= ThisApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap= ThisApplication.TransientObjects.CreateNameValueMap

If oSTEPTranslator.HasSaveCopyAsOptions(oDoc, oContext, oOptions) Then
' Set application protocol.
' 2 = AP 203 - Configuration Controlled Design
' 3 = AP 214 - Automotive Design
oOptions.Value("ApplicationProtocolType") = 5
' Other options...
'oOptions.Value("Author") = ""
'oOptions.Value("Authorization") = ""
'oOptions.Value("Description") = ""
'oOptions.Value("Organization") = ""
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oData As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
oData.FileName = sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".stp"
oSTEPTranslator.SaveCopyAs(oDoc, oContext, oOptions, oData)
End If
End Sub

Private Sub SaveAsImage(ByVal oDoc As Document)
Dim oApp As Inventor.Application = ThisApplication

'Dim sFilename As String = ThisDoc.PathAndFileName(True)
Dim sPath As String =  System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileName(oDoc.FullFileName)
Dim oCurView As Inventor.View= oApp.ActiveView
Try
oApp.ScreenUpdating = False
Dim oView As Inventor.View = oDoc.Views.Add()
oView.Visible = False

Dim oCamera As Camera = oView.Camera

oCamera.ViewOrientationType = kIsoTopRightViewOrientation
oCamera.Fit
oCamera.ApplyWithoutTransition

Dim oColor As Color= oApp.TransientObjects.CreateColor(255, 255, 255)
Call oCamera.SaveAsBitmap(sPath & "\PDM_IMPORT\" & sFile & "\" & sFile & ".jpg", 1920, 1080, oColor)

oView.Close
Catch ex As Exception
MsgBox(ex.Message)
Finally
oApp.ScreenUpdating = True
End Try
End Sub

Private Sub SaveAsdxf(ByVal oDoc As Document)

'oDoc = ThisApplication.ActiveDocument
Dim sPath As String =  System.IO.Path.GetDirectoryName(oDoc.FullFileName)
Dim sFile As String = System.IO.Path.GetFileName(oDoc.FullFileName)
   
    'Prüfen ob Datei ein Blech ist und falls keine Abwicklnug vorhanden Abwicklung erstellen
  If oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
          oFlatPattern = oDoc.ComponentDefinition.FlatPattern
          oSheetMetalCompDef = oDoc.ComponentDefinition
          If oSheetMetalCompDef.HasFlatPattern = False Then oSheetMetalCompDef.Unfold
  Else
        'Abbrechen, wenn kein Blechbauteil
      Exit Sub
  End If
 
    'Export der Abwicklung durchführen
    Dim sOut As String
sOut = "FLAT PATTERN DXF?AcadVersion=2004&OuterProfileLayer=WF_CUT&InteriorProfilesLayer=WF_CUT&InvisibleLayers=IV_FEATURE_PROFILES_DOWN;IV_TANGENT;IV_BEND;IV_BEND_DOWN;IV_ARC_CENTERS;IV_FEATURE_PROFILES;IV_FEATURE_PROFILES"
Dim sFname As String
sFname = sPath & "\PDM_IMPORT\" & sFile & "\Abwicklung\" & sFile & ".dxf"
System.IO.Directory.CreateDirectory (sPath & "\PDM_IMPORT\" & sFile & "\Abwicklung\")
oSheetMetalCompDef.DataIO.WriteDataToFile(sOut,sFname)
'oDoc = ThisApplication.ActiveDocument
Dim oSMDef As SheetMetalComponentDefinition
oSMDef = oDoc.ComponentDefinition
oSMDef.FlatPattern.ExitEdit

Dim oCD As SheetMetalComponentDefinition
    oCD = oDoc.ComponentDefinition

    Dim oFP As FlatPattern
    oFP = oCD.FlatPattern

    Dim dimX, dimY, dimZ As Double
    Dim sdimXYZ As String

    dimX = Round((oFP.Body.RangeBox.MaxPoint.X - oFP.Body.RangeBox.MinPoint.X) * 10, 3)
    dimY = Round((oFP.Body.RangeBox.MaxPoint.Y - oFP.Body.RangeBox.MinPoint.Y) * 10, 3)
    dimZ = Round((oFP.Body.RangeBox.MaxPoint.Z - oFP.Body.RangeBox.MinPoint.Z) * 10, 3)

    'Call IPropEintraege.Property_setzen(oDoc, "Groesse_Abwicklung", CStr(sdimXYZ))
    Dim oParams As Inventor.Parameters
    oParams = oDoc.ComponentDefinition.Parameters
 
    'Parameter löschen
    'oParams.UserParameters.Item(GrenzeAbwicklungX).Delete
    'oParams.UserParameters.Item(GrenzeAbwicklungY).Delete
    'oParams.UserParameters.Item(GrenzeAbwicklungZ).Delete
 
    'Parameter für Grenzen erstellen
    oParams.UserParameters.AddByValue ("GrenzeAbwicklungX", dimX / 10, kMillimeterLengthUnits)
    oParams.UserParameters.AddByValue ("GrenzeAbwicklungY", dimY / 10, kMillimeterLengthUnits)
    oParams.UserParameters.AddByValue("GrenzeAbwicklungZ", dimZ / 10, kMillimeterLengthUnits)
MsgBox ("GrenzeAbwicklungZ", dimZ)
 
    oFP = Nothing
    oCD = Nothing
    oDoc = Nothing
End Sub


------------------
Beste Grüße
Hans Peter

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: 01. Mrz. 2022 22: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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Der Code erstellt auch Benutzerparameter und keine iProps. Vielleicht liegt es daran. 
Kannst ja bei den Parametern die ExposedAsProperty Eigenschaft auf True setzen, dann werden die Parameter als benutzerdef. iProp exportiert. Unter dem CustomPropertyFormat des Benutzerparameters kannst dann noch einstellen wie das Exportformat aussehen soll.
Oder du erstellst direkt die iProps

Code:

iProperties.Value("Custom", "GrenzeAbwicklungX")= dimX / 10
iProperties.Value("Custom", "GrenzeAbwicklungY")= dimY / 10
iProperties.Value("Custom", "GrenzeAbwicklungZ")= dimZ / 10

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 02. Mrz. 2022 09: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,
ja das hätte ich auch verstehen können.
Hab das mit deinem Code ausgetauscht, aber bei mir werden die Properties nur in der obersten Baugruppe angelegt.

------------------
Beste Grüße
Hans Peter

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: 02. Mrz. 2022 17: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 HansPeterNew 10 Unities + Antwort hilfreich

Hallo

Achja, hatte vergessen dass es oben in einer Schleife durch alle Bauteile läuft. Der letzte Code schreibt nur die iProps in dem Dokument, in dem die Regel ausgeführt wird.
Versuch es mal so:

Code:

WriteProp(oDoc, "GrenzeAbwicklungX", dimX / 10)
WriteProp(oDoc, "GrenzeAbwicklungY", dimY / 10)
WriteProp(oDoc, "GrenzeAbwicklungZ", dimZ / 10)

Und noch diese Sub mit einfügen:

Code:

Private Sub WriteProp(ByVal oDoc As Document, ByVal sPropName As String, ByVal dPropValue As Double)
Dim oPropSet As PropertySet = oDoc.PropertySets.Item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")
Try
oPropSet.Add(dPropValue,sPropName)
Catch
oPropSet.Item(sPropName).Value=dPropValue
End Try

End Sub

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 03. Mrz. 2022 12:13    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

Vielen Vielen Dank!!

------------------
Beste Grüße
Hans Peter

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 02. Mai. 2022 12: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


S5.ipt

 
Hallo,

hier ist ein komischer Fehler aufgetreten, der sich bei ähnlichen Teilen wiederholt.
Durch die nicht ganz perfekte Kontur (Verformung beim Biegen oder durch Kundenzeichnungen)
stimmt der Z-Wert (Blechdicke) nicht mehr (24,8 anstatt 10). Dieser Wert ist aber wichtig, da wir damit automatisch das Laserteil erstellen, wenn der nicht stimmt haben wir ein Problem.
Habt ihr dafür irgendeine Lösung?
Hab das Teil angehängt.
Die Extursionen in der Abwicklung beheben das Problem, aber ich möchte nicht alle Teile nachbearbeiten...
Wie gesagt bearbeiten wir die Abwicklungen oft noch nach (Aufmaß o.ä.) und ich kann deshalb nicht die definierte Blechstärke verwenden.

Danke für euer Hilfe.

------------------
Beste Grüße
Hans Peter

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: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 02. Mai. 2022 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 Nur für HansPeterNew 10 Unities + Antwort hilfreich

Ich kann die Datei leider nicht öffnen. Trotzdem die Vermutung, dass die Problematik in diese Richtung gehen könnte:
ModTheMachine - Getting the Overall Size of Parts

Vielleicht liefert die OrientedMinimumRangeBox bessere Ergebnisse ...?
Endlich eine vernünftige Bounding Box IV 2021

Edit:
Das Objekt heißt OrientedBox.
Das Property eines SurfaceBody heißt OrientedMinimumRangeBox.

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

[Diese Nachricht wurde von KraBBy am 02. Mai. 2022 editiert.]

[Diese Nachricht wurde von KraBBy am 02. Mai. 2022 editiert.]

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 02. Mai. 2022 16: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

Hallo KraBBy,

war auch meine Vermutung.
Ich hab mich schon an der OrientedMinimumRangeBox versucht,
da bin ich programmiertechnisch aber zu schwach. (habs in der Abwicklung und in der Baugruppe nicht hingekriegt) 
Kann ich deshalb nicht beurteilen
Trotzdem danke für die schnelle Antwort

------------------
Beste Grüße
Hans Peter

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: 03. Mai. 2022 09:06    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 HansPeterNew 10 Unities + Antwort hilfreich

Moin

Da die Abwicklung nicht verdreht im Koordinatensystem liegt, wird die OrientedRangeBox in Z-Richtung vermutlich kaum andere Werte liefern.
Solche Importteile verursachen gern Probleme. Die verwundenen Flächen und die fehlende Eckfreistellung an den Biegungsenden ... wundert mich das Inventor das überhaupt abwickelt.
Ich würde im Biegungsteil alle Seitenflächen und die Flächen der Unterseite (ohne Korrektur) löschen. Anschließend mit Verdickung/Versatz wieder aufdicken. Dann hast du in der Abwicklung schonmal lotrecht stehende Seitenflächen. Hilft aber bei diesem Modell nicht bei der angeblichen Blechdicke laut RangeBox. Da ist noch irgendwas das die RangeBox aufweitet. Ich konnte es auch nicht finden.
Da in einer Blechabwicklung normalerweise Ober- und Unterseite planparallel verlaufen und ein Blech keine variierende Dicke hat, probiers mal ganz einfach mit:

Code:

Dim oPartDoc As PartDocument = ThisDoc.Document
Dim oCompDef As SheetMetalComponentDefinition = oPartDoc.ComponentDefinition
'Get minimum distance between flat pattern top and bottom face (distance is in database unist "cm")
Dim dDist As Double = ThisApplication.MeasureTools.GetMinimumDistance(oCompDef.FlatPattern.TopFace, oCompDef.FlatPattern.BottomFace)
'Convert distance to "mm"
dDist = oPartDoc.UnitsOfMeasure.ConvertUnits(dDist, UnitsTypeEnum.kDatabaseLengthUnits, UnitsTypeEnum.kMillimeterLengthUnits)
'Display distance
MsgBox(dDist & " mm",MsgBoxStyle.Information,"iLogic GetMinimumDistance")

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 03. Mai. 2022 12: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

Hallo,
ja das könnte gehen.
Hab es mit den Code unten getestet, der funktioniert auch.
Wenn ich aber in der Baugruppe speichere,
wird die Regel nicht ausgeführt (hab als Trigger nach öffnen von Dokument und vor dem Speichern von Dokument beim Bauteil)
Was mach ich falsch?
Code:
Sub Main
oDoc = ThisApplication.ActiveDocument
' Get the current Part document.
Dim partDoc As PartDocument = ThisDoc.Document

' Get surface body to measure (assume it's the first body).
Dim body1 As SurfaceBody = partDoc.ComponentDefinition.SurfaceBodies.Item(1)

' Get the oriented mininum range box of the body.
' NOTE: "OrientedMinimumRangeBox" was added in Inventor 2020.3/2021.
Dim minBox As OrientedBox = body1.OrientedMinimumRangeBox

' Get length of each side of mininum range box.
Dim dir1 As Double = minBox.DirectionOne.Length
Dim dir2 As Double = minBox.DirectionTwo.Length
Dim dir3 As Double = minBox.DirectionThree.Length

' Convert lengths to document's length units.
Dim uom As UnitsOfMeasure = partDoc.UnitsOfMeasure

dir1 = uom.ConvertUnits(dir1, "mm", uom.LengthUnits)*10
dir2 = uom.ConvertUnits(dir2, "mm", uom.LengthUnits)*10
dir3 = uom.ConvertUnits(dir3, "mm", uom.LengthUnits)*10

' Sort lengths from smallest to largest.
Dim lengths As New List(Of Double) From {dir1, dir2, dir3 }
lengths.Sort

Dim minLength As Double = lengths(0)
Dim midLength As Double = lengths(1)
Dim maxLength As Double = lengths(2)

' Display minimum rangebox size.
'MessageBox.Show("Oriented Minimum Rangebox Size: " &
' minLength.ToString("#.###") & " x " & midLength.ToString("#.###") & " x " & maxLength.ToString("#.###"),
' "Oriented Minimum Rangebox", MessageBoxButtons.OK, MessageBoxIcon.Information)

iProperties.Value("Custom", "Länge")= (Round(lengths(0),2))
iProperties.Value("Custom", "Breite")= (Round(lengths(1),2))
iProperties.Value("Custom", "Höhe")= (Round(lengths(2),2))
iProperties.Value("Custom", "Fläche")=(Round(iProperties.Area, 2))

 
    'Prüfen ob Datei ein Blech ist und falls keine Abwicklnug vorhanden Abwicklung erstellen
oDoc = ThisApplication.ActiveDocument
  If oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
          oFlatPattern = oDoc.ComponentDefinition.FlatPattern
          oSheetMetalCompDef = oDoc.ComponentDefinition
          If oSheetMetalCompDef.HasFlatPattern = False Then oSheetMetalCompDef.Unfold
  Else
        'Abbrechen, wenn kein Blechbauteil
      Exit Sub
  End If 
   
oDoc = ThisApplication.ActiveDocument
Dim oSMDef As SheetMetalComponentDefinition
oSMDef = oDoc.ComponentDefinition
oSMDef.FlatPattern.ExitEdit

Dim oCD As SheetMetalComponentDefinition
    oCD = oDoc.ComponentDefinition

    Dim oFP As FlatPattern
    oFP = oCD.FlatPattern

    Dim dimX, dimY, dimZ As Double
    Dim sdimXYZ As String

    dimX = Round((oFP.Body.RangeBox.MaxPoint.X - oFP.Body.RangeBox.MinPoint.X) * 10, 3)
    dimY = Round((oFP.Body.RangeBox.MaxPoint.Y - oFP.Body.RangeBox.MinPoint.Y) * 10, 3)
    dimZ = Round((oFP.Body.RangeBox.MaxPoint.Z - oFP.Body.RangeBox.MinPoint.Z) * 10, 3)
iProperties.Value("Custom", "AbwicklungX")= dimX
iProperties.Value("Custom", "AbwicklungY")= dimY
 
    oFP = Nothing
    oCD = Nothing
    oDoc = Nothing


Dim oPartDoc As PartDocument = ThisApplication.ActiveDocument
Dim oPpartDoc As PartDocument = ThisDoc.Document
Dim oCompDef As SheetMetalComponentDefinition = oPartDoc.ComponentDefinition
'Get minimum distance between flat pattern top and bottom face (distance is in database unist "cm")
Dim dDist As Double = ThisApplication.MeasureTools.GetMinimumDistance(oCompDef.FlatPattern.TopFace, oCompDef.FlatPattern.BottomFace)
'Convert distance to "mm"
dDist = oPartDoc.UnitsOfMeasure.ConvertUnits(dDist, UnitsTypeEnum.kDatabaseLengthUnits, UnitsTypeEnum.kMillimeterLengthUnits)
'Display distance
iProperties.Value("Custom", "Blechdicke")= dDist

End Sub


------------------
Beste Grüße
Hans Peter

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 03. Mai. 2022 12: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

hab vergessen dazuzuschreiben:
Externe Regel

------------------
Beste Grüße
Hans Peter

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: 601
Registriert: 19.09.2007

Inventor Professional 2020
WinX

erstellt am: 03. Mai. 2022 13:41    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 HansPeterNew 10 Unities + Antwort hilfreich

Ohne mir das genauer angesehen zu haben (von ausprobieren ganz zu schweigen), könnte es an
Code:
oDoc = ThisApplication.ActiveDocument
liegen. Das kommt mehrmals vor. Beim Auslösen der Regel aus einer Bgr. heraus, ist diese Bgr. das aktive Dokument.
Oben wird auch
Code:
ThisDoc.Document
verwendet, das sollte das Einzelteil, das gerade gespeichert wird, liefern (ganz sicher bin ich mir aber nicht).

Mit einer MsgBox ganz zu Beginn der Regel, könntest Du ausprobieren, ob sie tatsächlich nicht ausgeführt wird (oder nur still abbricht).

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

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

HansPeterNew
Mitglied
Technisches Büro


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

Beiträge: 45
Registriert: 19.10.2021

erstellt am: 03. Mai. 2022 16: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,

vielen Dank.
Habs ersetzt, jetzt funkt´s. Werde das jetzt auch mal ausgiebig testen und evt. melde ich mich nochmal.
Nochmal Kompliment: dieses Forum und die Antworten hier sind wirklich Spitze

------------------
Beste Grüße
Hans Peter

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