|  |  | 
|  | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | 
|  |  | 
|  | PNY wird von NVIDIA zum Händler des Jahres gewählt - zum dritten Mal in Folge, eine Pressemitteilung 
 | 
| Autor | Thema:  Auflösung/Größe Thumbnail (1549 /  mal gelesen) | 
 | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 23. Nov. 2021 10:01  <-- editieren / zitieren -->    Unities abgeben:            
  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
 
    
 
      Beiträge: 749Registriert: 19.09.2007
 Inventor Professional 2020WinX
 |    erstellt am: 24. Nov. 2021 17:31  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   | 
                        | rkauskh Moderator
 Dipl.-Ing. (FH) Versorgungstechnik, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 24. Nov. 2021 23:29  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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
 TryoApp.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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 25. Nov. 2021 09:23  <-- editieren / zitieren -->    Unities abgeben:            
 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
 TryoApp.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 onDim 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 = kIsoTopRightViewOrientationoCamera.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.UpdateEnd Try
 ------------------Beste Grüße
 Hans Peter
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 25. Nov. 2021 11:31  <-- editieren / zitieren -->    Unities abgeben:            | 
                        | rkauskh Moderator
 Dipl.-Ing. (FH) Versorgungstechnik, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 25. Nov. 2021 15:03  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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
 TryoApp.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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 25. Nov. 2021 15:33  <-- editieren / zitieren -->    Unities abgeben:            
  Hallo Ralf, Code:
 Option Explicit onDim 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 = kIsoTopRightViewOrientationoCamera.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.UpdateEnd Try
 
 
 Ich hab eigentlich nur Zeile 4Dim 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, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 25. Nov. 2021 20:43  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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
 TryoApp.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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 26. Nov. 2021 11:13  <-- editieren / zitieren -->    Unities abgeben:            | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 26. Nov. 2021 15:41  <-- editieren / zitieren -->    Unities abgeben:            | 
                        | rkauskh Moderator
 Dipl.-Ing. (FH) Versorgungstechnik, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 26. Nov. 2021 16:02  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 29. Nov. 2021 16:13  <-- editieren / zitieren -->    Unities abgeben:            
  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 = kIsoTopRightViewOrientationoCamera.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.CloseCatch 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, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 29. Nov. 2021 21:23  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 30. Nov. 2021 07:48  <-- editieren / zitieren -->    Unities abgeben:            
  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
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 01. Dez. 2021 15:59  <-- editieren / zitieren -->    Unities abgeben:            
  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, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 01. Dez. 2021 21:17  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 06. Dez. 2021 09:09  <-- editieren / zitieren -->    Unities abgeben:            | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 28. Feb. 2022 17:33  <-- editieren / zitieren -->    Unities abgeben:            
  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 = kIsoTopRightViewOrientationoCamera.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.CloseCatch 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&InteriorProfilesLayer=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, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 28. Feb. 2022 20:36  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 01. Mrz. 2022 18:08  <-- editieren / zitieren -->    Unities abgeben:            
  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 = kIsoTopRightViewOrientationoCamera.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.CloseCatch 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 FlatPatternoFP = oCD.FlatPattern
     Dim dimX, dimY, dimZ As DoubleDim 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, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 01. Mrz. 2022 22:38  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 02. Mrz. 2022 09:22  <-- editieren / zitieren -->    Unities abgeben:            
  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, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 02. Mrz. 2022 17:10  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 03. Mrz. 2022 12:13  <-- editieren / zitieren -->    Unities abgeben:            | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 02. Mai. 2022 12:35  <-- editieren / zitieren -->    Unities abgeben:            
  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
 
    
 
      Beiträge: 749Registriert: 19.09.2007
 Inventor Professional 2020WinX
 |    erstellt am: 02. Mai. 2022 16:15  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 02. Mai. 2022 16:37  <-- editieren / zitieren -->    Unities abgeben:            
  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, Master Eng. IT-Security & Forensic
 
        
 
  
 
      Beiträge: 2933Registriert: 15.11.2006
 Windows 10 x64, AIP 2020-2025 |    erstellt am: 03. Mai. 2022 09:06  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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 GmbHwww.RKW-Solutions.com
 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP | 
                        | HansPeterNew Mitglied
 Technisches Büro
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 03. Mai. 2022 12:10  <-- editieren / zitieren -->    Unities abgeben:            
  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)*10dir2 = 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 FlatPatternoFP = oCD.FlatPattern
     Dim dimX, dimY, dimZ As DoubleDim 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
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 03. Mai. 2022 12:15  <-- editieren / zitieren -->    Unities abgeben:            | 
                        | KraBBy Mitglied
 Maschinenbau-Ingenieur
 
    
 
      Beiträge: 749Registriert: 19.09.2007
 Inventor Professional 2020WinX
 |    erstellt am: 03. Mai. 2022 13:41  <-- editieren / zitieren -->    Unities abgeben:           Nur für HansPeterNew   
  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
 
  
 
      Beiträge: 45Registriert: 19.10.2021
 |    erstellt am: 03. Mai. 2022 16:11  <-- editieren / zitieren -->    Unities abgeben:            
  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 |