Moin zusammen,
nach dem ich im vergangen Jahr damit angefangen habe vieles im Inventor zu automatisieren und ich durch Jürgen Wagner auf seinen Inventor Programmierkurs hingewiesen wurde, habe ich vieles für den Inventor in VBA umgesetzt.
Da wir in unserem Unternehmen im Anlagenbau tätig sind und bei unseren Anlagen auch in Höhen gehen, müssen wir viele Kilometer an Geländer konstruieren. Durch meine Automatisierung (mittels iLogic und VBA) in der Konstruktion haben wir ein Team gebildet was sich zur Aufgabe gemacht hat Konstruktionen zu Standardisieren und automatisieren.
Das Geländer habe ich mittels iLogic aufgebaut und mit VBA verknüpft. Nicht benötigte Bauteile werden unterdrückt.
Damit nun das neu erzeugte Geländer keinen Bezug mehr zum iLogic Muttergeländer haben soll, habe ich die Routine ReplaceReference() geschaffen.
ReplaceReference korrigiert die Bezeichnung (die Bezeichnung wird vom Konstrukteur 1x manuell angegeben) aller 3D-Modelle einschl. deren 3D-Referenzen.
Leider werden Bauteile bei denen mehre gleiche Bauteile Unterdrückt sind sowie auch die 3D-Referenzen von ReplaceReference überlesen.
Sind aber alle Bauteile einer Baugruppe nicht Unterdrückt werden die Bezeichnungen der 3D-Modelle sowie Dateireferenzen entsprechend geändert.
Danach speichern des Erzeugten Geländers.
Nun meine Frage:
Warum werden Bauteile die Unterdrückt sind von ReplaceReference übersehen auch wenn Unterdrücke zuvor gelöscht wurden?
Wer kann weiterhelfen?
********************************************************************************************************
Hier die Rule:
Function ReplaceReference()
'Setzen der Baugruppe a ls aktuelles Dokument
Dim oDocAssem As AssemblyDocument 'oDocAssem = gesamte Baugruppe)
'Dim oDocAssemblyNew As String 'nur für's Debugging
'oFileAssemblyNew = "d:\Arbeitsbereich\Retek\ERP\29\016\29-016-019\29-016-019.iam<DetailgenauigkeitGeländer>" 'nur für's Debugging
oFileAssemblyNew = oDocAssemblyNew & "<DetailgenauigkeitGeländer>"
'MsgBox (oFileAssemblyNew)
Set oDocAssem = ThisApplication.Documents.Open(oFileAssemblyNew, True)
'Löschen von unterdrücken Bauteilen
'Call RemoveSuppressed
oFileElementNew = Left(oDocAssem.DisplayName, (Len(oDocAssem.DisplayName) - 32))
MsgBox (oFileElementNew)
oFileAssemblyNew = Left(oFileAssemblyNew, (Len(oFileAssemblyNew) - 42))
MsgBox (oFileAssemblyNew)
'oRefDocs (Auflistung aller Documents in der Baugruppe) = AllreferencedDocuments von TypDocumentsEnumerator
Dim oRefDocs As DocumentsEnumerator
'AllReferencedDocuments = ALLE enthaltenen Dateien
Set oRefDocs = oDocAssem.AllReferencedDocuments
'Bauteil als aktuelles Dokument setzen
Dim oRefDoc As Document
'Es sollen nur Zeichnungen berücksichtigt werden die im gleichen Pfad sind
'also nur Fullfilename abzüglich der letzten 4 Zeichen gesetzt werden
'(ohne Dateiendung wie .ipt oder .iam) im gleichen Zeichnungpfad.
'Left = abschneiden des Linken Teil, Len = Ermittlung der Länge eines Strings.
'Left (Hallo,2) = Ha.
'oZeichPath = Left(oRefDoc.FullFileName, (Len(oRefDoc.FullFileName) - 4))
'FileSystemobject zwecks Prüfung, ob die Zeichnung überhaupt als Datei auf der Festplatte existiert.
'Siehe googel z.B. nach "VBA prüfen ob Datei existiert" oder sowas 🙂
'Dim objFso As Object
'Set objFso = CreateObject("Scripting.FileSystemObject")
Dim oDocRef As Document
Set oDocRef = ThisApplication.ActiveDocument
Dim oRefFile As FileDescriptor
Dim oOrigRefName, oOrigFullFileName, selectedfile As String
For Each oRefFile In oDocAssem.File.ReferencedFileDescriptors
'setzen des vollständigen Dateipfades
oOrigFullFileName = oRefFile.FullFileName
'MsgBox (oOrigFullFileName)
'oOrigRefName = oRefDoc.DisplayName
oOrigRefName = Right(oRefFile.FullFileName, (Len(oRefFile.FullFileName) - 44))
MsgBox (oOrigRefName)
'oFileElementNew = Left(oDocAssem.DisplayName, (Len(oDocAssem.DisplayName) - 32))
'Setzen von Objekt Variabeln für Dateiauswahldialog
Dim oFileDlg As Inventor.FileDialog
Set oFileDlg = Nothing
Call ThisApplication.CreateFileDialog(oFileDlg)
oFileDlg.InitialDirectory = oOrigRefName
oFileDlg.CancelError = True
On Error Resume Next
'Legende:
'_001 = Knieleiste
'_002 = AnschraubplatteMitte
'_003 = Pfosten
'_004 = Fussleiste
'_005 = AnschraubplattePfosten
'_006 = Handlauf
If oOrigRefName = "AnschraubplatteMitte.ipt" Then
selectedfile = oFileAssemblyNew & "\" & oFileElementNew & "_001.ipt"
Debug.Print selectedfile
ElseIf oOrigRefName = "Knieleiste.ipt" Then
selectedfile = oFileAssemblyNew & "\" & oFileElementNew & "_002.ipt"
Debug.Print selectedfile
ElseIf oOrigRefName = "Pfosten.ipt" Then
selectedfile = oFileAssemblyNew & "\" & oFileElementNew & "_003.ipt"
Debug.Print selectedfile
ElseIf oOrigRefName = "Fussleiste.ipt" Then
selectedfile = oFileAssemblyNew & "\" & oFileElementNew & "_004.ipt"
'Debug.Print selectedfile
ElseIf oOrigRefName = "AnschraubplattePfosten.ipt" Then
selectedfile = oFileAssemblyNew & "\" & oFileElementNew & "_005.ipt"
'Debug.Print selectedfile
ElseIf oOrigRefName = "Handlauf.ipt" Then
selectedfile = oFileAssemblyNew & "\" & oFileElementNew & "_006.ipt"
'Debug.Print selectedfile
End If
If Err.Number <> 0 Then
Return
'ElseIf oFileDlg.Filename <> "" Then
ElseIf oOrigRefName.Filename <> "" Then
selectedfile = oFileElementNew.Filename
selectedfile = oDocElement.Filename
MsgBox (selectedfile)
End If
'Modell-Referenz ersetzen
oRefFile.ReplaceReference (selectedfile)
oOrigFullFileName = ""
oDocAssem.Update
Next
'Löschen von unterdrücken Bauteilen
'Call RemoveSuppressed
Call oDocAssem.SaveAs(oDocAssem.FullFileName, True)
Call oDocAssem.Close(True)
'iLogicVb.UpdateWhenDone = True
End Function
Sobald ich die Funktion ReplaceReference sauber laufen habe würde ich den kompletten Quelltext hier im Forum zur Verfügung stellen. ReplaceReference ist nur ein Teil, aber ein wichtiger Teil für das iLogic Geländer.
Gruß
Matthias
