Ilogic Rule Crashes Inventor

Ilogic Rule Crashes Inventor

Anonymous
Not applicable
1,001 Views
8 Replies
Message 1 of 9

Ilogic Rule Crashes Inventor

Anonymous
Not applicable

Hi,

I have the attached code which updates several parts and drawings according to model properties compares duplicates on excel, then copy-pastes them onto my GA , My code worked on my first project but now that Im using it on another project it crashes inventor every time. I've tried using another PC however that hasnt fixed the issue either. Would really appreciate if anyone could help out in fixing this problem. ( I know its a heavy code but I couldnt manage to make it shorter or easier for the PC to process.)

 

Thanks in advance,

0 Likes
1,002 Views
8 Replies
Replies (8)
Message 2 of 9

bradeneuropeArthur
Mentor
Mentor

Hi,

 

Is this your complete code?

There are either End if 's Or End's missing...

 

Regards,

Regards,

Arthur Knoors

Autodesk Affiliations & Links:
blue LinkedIn LogoSquare Youtube Logo Isolated on White Background


Autodesk Software:Inventor Professional 2025 | Vault Professional 2024 | Autocad Mechanical 2024
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:
Drawing List!|
Toggle Drawing Sheet!|
Workplane Resize!|
Drawing View Locker!|
Multi Sheet to Mono Sheet!|
Drawing Weld Symbols!|
Drawing View Label Align!|
Open From Balloon!|
Model State Lock!
Posts and Ideas:
My Ideas|
Dimension Component!|
Partlist Export!|
Derive I-properties!|
Vault Prompts Via API!|
Vault Handbook/Manual!|
Drawing Toggle Sheets!|
Vault Defer Update!

! For administrative reasons, please mark a "Solution as solved" when the issue is solved !


 


EESignature

0 Likes
Message 3 of 9

Anonymous
Not applicable

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

 

0 Likes
Message 4 of 9

bradeneuropeArthur
Mentor
Mentor

try this out:

Sub Main ()
	
	
'''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

Regards,

Arthur Knoors

Autodesk Affiliations & Links:
blue LinkedIn LogoSquare Youtube Logo Isolated on White Background


Autodesk Software:Inventor Professional 2025 | Vault Professional 2024 | Autocad Mechanical 2024
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:
Drawing List!|
Toggle Drawing Sheet!|
Workplane Resize!|
Drawing View Locker!|
Multi Sheet to Mono Sheet!|
Drawing Weld Symbols!|
Drawing View Label Align!|
Open From Balloon!|
Model State Lock!
Posts and Ideas:
My Ideas|
Dimension Component!|
Partlist Export!|
Derive I-properties!|
Vault Prompts Via API!|
Vault Handbook/Manual!|
Drawing Toggle Sheets!|
Vault Defer Update!

! For administrative reasons, please mark a "Solution as solved" when the issue is solved !


 


EESignature

0 Likes
Message 5 of 9

Anonymous
Not applicable

Unfortunately its still crashing, also I couldnt tell what you changed in the code?

0 Likes
Message 6 of 9

bradeneuropeArthur
Mentor
Mentor

I received an error with:

Sub Main Open_File()

And changed it to this:

Sub Main()

 Regards,

Regards,

Arthur Knoors

Autodesk Affiliations & Links:
blue LinkedIn LogoSquare Youtube Logo Isolated on White Background


Autodesk Software:Inventor Professional 2025 | Vault Professional 2024 | Autocad Mechanical 2024
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:
Drawing List!|
Toggle Drawing Sheet!|
Workplane Resize!|
Drawing View Locker!|
Multi Sheet to Mono Sheet!|
Drawing Weld Symbols!|
Drawing View Label Align!|
Open From Balloon!|
Model State Lock!
Posts and Ideas:
My Ideas|
Dimension Component!|
Partlist Export!|
Derive I-properties!|
Vault Prompts Via API!|
Vault Handbook/Manual!|
Drawing Toggle Sheets!|
Vault Defer Update!

! For administrative reasons, please mark a "Solution as solved" when the issue is solved !


 


EESignature

0 Likes
Message 7 of 9

bradeneuropeArthur
Mentor
Mentor

What I normally do in these cases:

I put a msgbox between all "If" statements>>

Like:

msgbox ("1")

msgbox ("2")

msgbox ("3")

msgbox ("and so on")

 

To check where the code crashes.

Let me know where the code has problems.

Regards,

 

Regards,

Arthur Knoors

Autodesk Affiliations & Links:
blue LinkedIn LogoSquare Youtube Logo Isolated on White Background


Autodesk Software:Inventor Professional 2025 | Vault Professional 2024 | Autocad Mechanical 2024
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:
Drawing List!|
Toggle Drawing Sheet!|
Workplane Resize!|
Drawing View Locker!|
Multi Sheet to Mono Sheet!|
Drawing Weld Symbols!|
Drawing View Label Align!|
Open From Balloon!|
Model State Lock!
Posts and Ideas:
My Ideas|
Dimension Component!|
Partlist Export!|
Derive I-properties!|
Vault Prompts Via API!|
Vault Handbook/Manual!|
Drawing Toggle Sheets!|
Vault Defer Update!

! For administrative reasons, please mark a "Solution as solved" when the issue is solved !


 


EESignature

0 Likes
Message 8 of 9

Anonymous
Not applicable

Hmm, I've tried it and it crashes after msgbox("11") has been displayed

 

Sub Main ()
	
	
'''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"
			MsgBox("1")
			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
			MsgBox("2")
			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
			MsgBox("3")
		

			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("4")
			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İ''''''''''''''''''''''''
MsgBox("5")
	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
	MsgBox("6")
'''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
'						
'''			''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MsgBox("7")	
					'''''''''''''''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
MsgBox("8")
									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
MsgBox("9")
											templatePRT.Save
											templatePRT.Close(True)
MsgBox("10")
										'''''''''''''''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
MsgBox("11")													 
										'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
MsgBox("12")	
End If

'''END POINT FOR IF COMMANDS'''


MsgBox("13")

Next
'''for command end point'''		
''' 
MsgBox("14")
GoExcel.Save

GoExcel.Close

End Sub
0 Likes
Message 9 of 9

bradeneuropeArthur
Mentor
Mentor

then next step:

put this between point 11 and 12

 

MsgBox("11")													 
										'Copy View from template drawing to Main drawing
											copyView = templateDWG.Sheets.Item(1).DrawingViews.Item(1)
											MsgBox (copyView.Name)
										'MessageBox.Show(copyView.Name, "Drawing View Selection")
											copyView.CopyTo(mainDWG.Sheets.Item(1))
										'Close Template drawing
										MsgBox (templateDWG.FullFileName)
											templateDWG.Close(True)'Skip save on template drawing		
'																		    
						End If

Regards,

Arthur Knoors

Autodesk Affiliations & Links:
blue LinkedIn LogoSquare Youtube Logo Isolated on White Background


Autodesk Software:Inventor Professional 2025 | Vault Professional 2024 | Autocad Mechanical 2024
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:
Drawing List!|
Toggle Drawing Sheet!|
Workplane Resize!|
Drawing View Locker!|
Multi Sheet to Mono Sheet!|
Drawing Weld Symbols!|
Drawing View Label Align!|
Open From Balloon!|
Model State Lock!
Posts and Ideas:
My Ideas|
Dimension Component!|
Partlist Export!|
Derive I-properties!|
Vault Prompts Via API!|
Vault Handbook/Manual!|
Drawing Toggle Sheets!|
Vault Defer Update!

! For administrative reasons, please mark a "Solution as solved" when the issue is solved !


 


EESignature

0 Likes