Yes its my complete code I've just shortened it to 200 lines in hopes that it would stop crashing but if anything it makes inventor crash faster and gives a catastrophic failure 😞 Here's the code.
Sub Main Open_File()
'''LOGITUDINAL WELD DETAIL GENERATOR'''
Dim mainDWG As DrawingDocument = ThisDoc.Document
Dim templateDWG As DrawingDocument
Dim templatePRT As PartDocument
Dim templatePart As String
Dim templateName As String
'''OPEN EXCEL & CLEAR CELLS''''
Dim xlsxPath As String
xlsxPath= "C:\Users\tm04.smeric\Desktop\Inventor Ilogic Templates\WELD DETAIL LIST.xlsx"
' xlsxPath = "C:\Users\tm04.oergin\Desktop\Inventor Ilogic Templates\WELD DETAIL LIST.xlsx"
''' Template Path for Part & Dwg files'''
Dim templatePath As String = "C:\Users\tm04.smeric\Desktop\Inventor Ilogic Templates\"
' Dim templatePath As String = "C:\Users\tm04.oergin\Desktop\Inventor Ilogic Templates\"
GoExcel.Open(xlsxPath, "Sheet1")
'
Dim ColumnA, ColumnB, ColumnC, ColumnD, ColumnE, ColumnF, ColumnG, ColumnH, ColumnI As String
ColumnA = "A"
ColumnB = "B"
ColumnC = "C"
ColumnD = "D"
ColumnE = "E"
ColumnF = "F"
ColumnG = "G"
ColumnH = "H"
ColumnI = "I"
Dim Row As Integer
''' CLEAR CONTENTS '''
Row = 2
While Row < 100
GoExcel.CellValue(ColumnA & Row) = "" 'Value
GoExcel.CellValue(ColumnB & Row) = "" 'Value
GoExcel.CellValue(ColumnG & Row) = "" 'Value
Row = Row+1
End While
GoExcel.DisplayAlerts = False
'''''''''''''''''''''''''DOSYADAN VERİ ÇEKME '''''''''''''''''''''''''''''''''
Dim openDoc As Document = ThisDoc.Document
Row = 1
For Each doc As Document In openDoc.AllReferencedDocuments
On Error Resume Next
Dim TekfenDrawingCategoryproset As PropertySet
TekfenDrawingCategoryproset = doc.PropertySets.Item("Inventor User Defined Properties")
If TekfenDrawingCategoryproset.Item("componentType").Value = "Cylinder" Or TekfenDrawingCategoryproset.Item("componentType").Value = "Skirt" Then
MsgBox(TekfenDrawingCategoryproset.Item("componentType").Value)
Dim IDproset, t1proset As PropertySet
Dim IDproperty, t1property As Inventor.Property
Dim ID, t1 As Double
IDproset = doc.PropertySets.Item("Inventor User Defined Properties")
t1proset = doc.PropertySets.Item("Inventor User Defined Properties")
'''ROW'''
Row = Row + 1
' MsgBox(Row)
''''''''''''''''''''''ID ve t1 ATAMA''''''''''''''''''''''''''''''''''
ID = IDproset.Item("innerDiameter").Value
'MsgBox(ID)
t1 = t1proset.Item("nominalThickness").Value
'MsgBox(t1)
'''TEST ETMEK ICIN''''''''''''''''''''''
' ID = 400 'Test etmek icin
' t1 = 13
''''''''''''''''''''''''''''''''''''''''
Dim thickness1 As Double
Dim oPartDoc As PartDocument
Dim oC As ComponentDefinition
Dim oViewRep As String
Dim copyView As DrawingView
'''''''''''''VERİLERE GÖRE KAYNAK AĞZI SEÇİMİ''''''''''''''''''''''''
If ID = 0 Or t1 = 0 Then
'nothing will be done if values are 0 & 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''1
ElseIf ID <= 500 Then ' ID<=500
templatePart = "SekilA_ID500.ipt"
templateName = "SekilA_ID500.dwg"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''2
ElseIf ID < 900 Then ''''''''500<ID<900
If t1 <= 12 Then 't<=12
templatePart = "SekilA_ID500_900_0t12.ipt"
templateName = "SekilA_ID500_900_0t12.dwg"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''3
Else '500<ID<900 ; t>12
templatePart = "SekilB_ID500_900_12t.ipt"
templateName = "SekilB_ID500_900_12t.dwg"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''4
Else 'ID>=900
If t1 <= 12 Then 't<=12
templatePart = "SekilA_ID900_0t12.ipt"
templateName = "SekilA_ID900_0t12.dwg"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''5
ElseIf t1 < 40 Then
templatePart = "SekilB_ID900_12t40.ipt"
templateName = "SekilB_ID900_12t40.dwg"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''6
ElseIf t1 < 80 Then '40<=t<80
templatePart = "SekilB_ID900_40t80.ipt"
templateName = "SekilB_ID900_40t80.dwg"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''7
ElseIf t1>80 't>=80
templatePart = "SekilB_ID900_80t.ipt"
templateName = "SekilB_ID900_80t.dwg"
End If
End If
'''if ID....END POINT
''''''''THICKNESS VALUE CONTROL''''''''''
GoExcel.CellValue(xlsxPath, "Sheet1", ColumnG & Row) = TekfenDrawingCategoryproset.Item("componentType").Value
GoExcel.CellValue(xlsxPath, "Sheet1", ColumnA & Row) = t1
GoExcel.CellValue(xlsxPath, "Sheet1", ColumnB & Row) = ID
'
''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''BURDA DUZELTME YAP'''''''''''''''''''
If GoExcel.CellValue(xlsxPath, "Sheet1", ColumnI & Row) = "Unique" Then
'''''''' Part Dosyasını acma ''''''''
ThisApplication.Documents.Open(templatePath & templatePart, True)
templatePRT = ThisApplication.ActiveDocument
'''''''''''''''' Part Thickness Atama '''''''''''''''''''
thickness1 = t1
oPartDoc = ThisApplication.ActiveDocument
oC = oPartDoc.ComponentDefinition
oViewRep = oC.RepresentationsManager.ActiveDesignViewRepresentation.Name
If oViewRep = "Master" Then
Dim oName As String
oC.Parameters.Item("thickness1").Value = thickness1/10
oPartDoc.Update
ElseIf oViewRep = "View1" Then
oC.Parameters.Item("thickness1").Value = thickness1/10
oPartDoc.Update
End If
templatePRT.Save
templatePRT.Close(True)
'''''''''''''''Open Dwg , Copy-Paste View, Close Dwg''''''''''''''''''''''
'Open Template drawing
ThisApplication.Documents.Open(templatePath & templateName, True)
templateDWG = ThisApplication.ActiveDocument
Dim oDoc As DrawingDocument
oDoc = ThisDoc.Document
Dim oSheets As Sheets
Dim oViews As DrawingViews
oSheets = oDoc.Sheets
'
'Copy View from template drawing to Main drawing
copyView = templateDWG.Sheets.Item(1).DrawingViews.Item(1)
'MessageBox.Show(copyView.Name, "Drawing View Selection")
copyView.CopyTo(mainDWG.Sheets.Item(1))
'Close Template drawing
templateDWG.Close(True)'Skip save on template drawing
'
End If
End If
'''END POINT FOR IF COMMANDS'''
Next
'''for command end point'''
'''
GoExcel.Save
GoExcel.Close
End Sub