Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Annnnnd here's what it looks like refactored into a slightly more logical layout.

 

A ton of redundancy and unused lines were also removed.

 

There might be some bugs to fix yet/some extra error checking to add, but at least it should be much, much easier to follow.

 

Sub Main()

    Dim oDoc As Inventor.Document
    oDoc = ThisDoc.Document
  	
    oDrawCurveSeg = ThisApplication.CommandManager.Pick(Inventor.SelectionFilterEnum.kDrawingCurveSegmentFilter, "Select a Drawing Curve")

'Input validation
    Dim oDrawCurve As DrawingCurve
	Try
		oDrawCurve = oDrawCurveSeg.Parent
	Catch ex As Exception
		MessageBox.Show("No drawing curve found.", "iLogic")
		Exit Sub
	End Try

	Dim oSelectedModelDoc As Document
	Try
    	oSelectedModelDoc = oDrawCurve.ModelGeometry.Parent.ComponentDefinition.Document
	Catch
			MsgBox("No model assosciated with selected curve found!")
	End Try				
'End of input validation

	'Create a default description
    AutoName = AutoDescriptionBasedonType(oSelectedModelDoc)
	
	oPart = System.IO.Path.GetFileName(oSelectedModelDoc.FullFileName)
	
'Provide final user input to verify name
	oNewDescription = InputBox("Description for '" & oPart & "':", "Description Editor", AutoName)
		
	If oNewDescription = "" Then
		'Cancel if no description is entered.
		MessageBox.Show("Description change cancelled.", "iLogic")
	Else
		'Change part description
		iProperties.Value(oPart, "Project", "Description") = oNewDescription
		InventorVb.DocumentUpdate()
		'Restart to choose next part
		iLogicVb.RunRule("Dimensions - Individual")
	End If
	
End Sub

Sub GetDocDims(oDoc As Document, ByRef Length As String, ByRef Width As String, ByRef Thickness As String)

	'Grab range box of each surface body and combine to get the max range box
	'Get the overall dims using the rangebox max/min points
	'Sort these overall dims from smallest to largest and assign as length width and thickness
	
	Dim oCompDef As ComponentDefinition 
	oCompDef = oDoc.ComponentDefinition
	
	Dim uom as UnitsOfMeasure = oDoc.UnitsOfMeasure	
	
	Dim minp As point
	Dim maxp As point
	
	Dim oRB As Box
	Try
		For Each sb In oCompDef.SurfaceBodies
			If oRB Is Nothing Then
				oRB = sb.RangeBox.Copy
			Else
				oRB.Extend(sb.RangeBox.MinPoint)
				oRB.Extend(sb.RangeBox.MaxPoint)
			End If
		Next
		
		minp = oRB.minPoint
		maxp = oRB.maxPoint
	Catch ex As Exception
		MessageBox.Show("Error finding extensions for part: " & partName, "iLogic")
		Exit Sub
	End Try

	'Get part dimensions
	dp=0
	X = Round(uom.ConvertUnits ((maxP.X - minP.X), "cm", uom.LengthUnits), dp)
	Y = Round(uom.ConvertUnits ((maxP.Y - minP.Y), "cm", uom.LengthUnits), dp)
	Z = Round(uom.ConvertUnits ((maxP.Z - minP.Z), "cm", uom.LengthUnits), dp)

	Dim extents As New ArrayList()
	extents.add(X)
	extents.add(Y)
	extents.add(Z)
	
	extents.Sort()

	Thickness = extents(0)
	Width = extents(1)
	Length = extents(2)
	
End Sub

Sub GetClassAndStandFromProperty(oPN As String, ByRef oClass as String, ByRef stand As String)
		'Get classification for fasteners
		Dim stockclass() As String
		Try
			stockclass = Split(oPN, "-")
			
			oClass = stockclass(1)
			oClass = Right(oClass, Len(oClass)-1)
			
			If InStr(oClass, " ") > 0 Then
				oClass = Left(oClass, InStr(oClass, " ")-1)
			End If
			
			If Not UCase(Left(oClass, 1)) = "M" Then
				oClass = oClass & """"
				If Not InStr(oPN, "UNC") = 0 Then
					stand = " UNC"
				End If
				
				If Not InStr(oPN, "UNF") = 0 Then
					stand = " UNF"
				End If
			Else
				stand = ""
			End If
		Catch
		End Try
End Sub

Function GetParamTypeFromList() As String

	Dim paramstocheck As New ArrayList()
	paramstocheck.add("G_NG")
	paramstocheck.add("G_T")
	paramstocheck.add("G_W")
	paramstocheck.add("G_ER")
	paramstocheck.add("G_T1")
	paramstocheck.add("G_H")
	paramstocheck.add("b")
	paramstocheck.add("NLG")
	paramstocheck.add("SW")
	paramstocheck.add("SD2")
	paramstocheck.add("SEWI")
	paramstocheck.add("KOD")
	paramstocheck.add("FAWI")
	paramstocheck.add("SD2")
	'paramstocheck.add("[NEW PARAMETER TO CHECK]")
	
	'Create a list of parameters found out of those checked.
	Dim params As New ArrayList()
	For Each param in paramstocheck
		'MessageBox.Show("Checking for: " & param, "iLogic")
		Try
			params.Add(param)
		Catch
		End Try
	Next
	
	If params.Contains("G_NG") Then
		AutoType = "PFC"
	ElseIf (Not params.Contains("G_T1")) And params.Contains("G_W") And (Not params.Contains("G_ER")) And params.Contains("G_T") Then
		AutoType = "RHS"
	ElseIf params.Contains("G_T") And (Not params.Contains("G_W")) Then
		AutoType = "CHS"
	ElseIf (Not params.Contains("G_T")) And (Not params.Contains("G_W")) And params.Contains("G_H") Then
		AutoType = "RD BAR"	
	ElseIf params.Contains("G_T1") And (Not params.Contains("G_NG")) Then
		AutoType = "UC"
	ElseIf params.Contains("G_ER") Or params.Contains("b") Then
		AutoType = "RSA"
	ElseIf params.Contains("G_W") And (Not params.Contains("G_T")) Then
		AutoType = "F BAR"
	ElseIf params.Contains("NLG") And params.Contains("SW")And params.Contains("SD2") Then
		AutoType = "BOLT"
	ElseIf params.Contains("SW") And (Not params.Contains("NLG")) Then
		AutoType = "NUT"
	ElseIf params.Contains("SD2") And (Not params.Contains("NLG")) Then
		AutoType = "WASHER"
	ElseIf params.Contains("SEWI") Then
		AutoType = "C SINK"
	ElseIf params.Contains("KOD") And (Not params.Contains("SEWI")) Then
		AutoType = "SOCKET SCREW"
	ElseIf params.Contains("FAWI") Then
		AutoType = "GRUB"
	ElseIf (Not params.Contains("B_L")) Then
		AutoType = "PLATE"
	Else
		AutoType = ""
	End If
	
	Return AutoType
End Function

Function AutoDescriptionBasedonType(oDoc As Document) As String

	'To Auto description, we need dims, classification, standard, and stock number values to check against.
	'We also need to establish a type (which may or may not already be in the part) to establish what we want 
	'the Default description To be

'Value Prep
'[
	

	Dim Length, Width, Thickness As String
	Call GetDocDims(oDoc, Length, Width, Thickness)	
	
	Dim oClass, stand As String
	Dim oPN As String
	oPN = iProperties.Value(oPart, "Project", "Part Number")
	Call GetClassAndStandFromProperty(oPN, oClass, stand)	

	Dim stockprops() As String
	Try
		stockprops = Split(iProperties.Value(oPart, "Project", "Stock Number"), "x")
	Catch
	End Try
']

'Get Type
'[
	Try
		oType = Parameter(oPart, "Type")
	Catch ex As Exception
		oType = GetParamTypeFromList()
	End Try
	
	'Set Shape Type
	If oType = "" Then
		'Prompt for manual input - in format "PFC", "F BAR", "RD BAR", "UC", etc.
		oType = InputBox("Treat as:", "Part Type", AutoType)
	End If
']

	AutoName = ""
	Try	
		Select Case UCase(oType)
			Case "PLATE"
				AutoName = "PLT " & Thickness & " THK " & Length & " x " & Width
				
			Case "F BAR"
				AutoName = "F/BAR " & Width & " x " & Thickness
				
			Case "CHS"
				AutoName = "CHS " & Parameter(oPart, "G_H") & " OD x " & Parameter(oPart, "G_T") & " WT"
				
			Case "SHS", "RHS"
				If Parameter(oPart, "G_W") = Parameter(oPart, "G_H") Then
					AutoName = "SHS " & Parameter(oPart, "G_H") & " x " & Parameter(oPart, "G_W") & " x " & Parameter(oPart, "G_T")
				Else
					AutoName = "RHS " & Parameter(oPart, "G_H") & " x " & Parameter(oPart, "G_W") & " x " & Parameter(oPart, "G_T")
				End If
				
			Case "RD BAR"
					AutoName = "RD BAR DIA. " & Parameter(oPart, "G_H")
					
			Case "RSA"
				Try 
					AutoName = "RSA " & Parameter(oPart, "G_H") & " x " & Parameter(oPart, "G_W") & " x " & Parameter(oPart, "G_T")
				Catch
					AutoName = "RSA " & Parameter(oPart, "b") & " x " & Parameter(oPart, "b") & " x " & Parameter(oPart, "ParT")
				End Try
				
			Case "PFC"
				AutoName = "PFC " & stockprops(0) & " x " & stockprops(1) & " x " & stockprops(2)
			
			Case "UC", "UB"
				'Distinguish between collumn and beam
				If Val(stockprops(0)) <= Val(stockprops(1)) Then
					AutoName = "UC " & stockprops(0) & " x " & stockprops(1) & " x " & stockprops(2)
				Else
					AutoName = "UB " & stockprops(0) & " x " & stockprops(1) & " x " & stockprops(2)
				End If
		
			Case "BOLT"
				AutoName = oClass & stand & " HEX BOLT"
		
			Case "NUT"
				AutoName = oClass & stand & " HEX NUT"
		
			Case "WASHER"
				AutoName = oClass & " FLAT WASHER, FORM A"
		
			Case "C SINK"
				AutoName = oClass & stand & " COUNTERSINK SCREW"
		
			Case "SOCKET SCREW"
				AutoName = oClass & stand & " SOCKET SCREW"
		
			Case "GRUB"
				AutoName = oClass & stand & " GRUB SCREW"
			Case Else
				AutoName = ""
		End Select
	Catch
		AutoName = ""
	End Try
	
	Return AutoName
End Function

--------------------------------------
Did you find this reply helpful ? If so please use the 'Accept as Solution' or 'Like' button below.

Justin K
Inventor 2018.2.3, Build 227 | Excel 2013+ VBA
ERP/CAD Communication | Custom Scripting
Machine Design | Process Optimization


iLogic/Inventor API: Autodesk Online Help | API Shortcut In Google Chrome | iLogic API Documentation
Vb.Net/VBA Programming: MSDN | Stackoverflow | Excel Object Model
Inventor API/VBA/Vb.Net Learning Resources: Forum Thread

Sample Solutions:Debugging in iLogic ( and Batch PDF Export Sample ) | API HasSaveCopyAs Issues |
BOM Export & Column Reorder | Reorient Skewed Part | Add Internal Profile Dogbones |
Run iLogic From VBA | Batch File Renaming| Continuous Pick/Rename Objects

Local Help: %PUBLIC%\Documents\Autodesk\Inventor 2018\Local Help

Ideas: Dockable/Customizable Property Browser | Section Line API/Thread Feature in Assembly/PartsList API Static Cells | Fourth BOM Type