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

Another update.

 

I wish I could just edit my original post, but I don't seem to be able to, so here's the update:

 

	'Code to modify a part's description iPorperty based on shape. Created by Jonathan Fowler.
	'Works by selecting a line segment from a part in a drawing view.

	'Document declaration
    Dim oDoc As Inventor.Document
    oDoc = ThisApplication.ActiveDocument
 
    'Prompt user to pick a line segment
    'Dim oDrawCurveSeg As DrawingCurveSegment
    oDrawCurveSeg = ThisApplication.CommandManager.Pick _
     (Inventor.SelectionFilterEnum.
      kDrawingCurveSegmentFilter,
      "Select a Drawing Curve")

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

    'Get the model geometry this curve represents.
    Dim oModelGeom As Object
    oModelGeom = oDrawCurve.ModelGeometry
	
	'Check to see if the returned object supports
    'the ContainingOccurrence property.
    Dim oOcc As ComponentOccurrence
	
	Try
    	oOcc = oModelGeom.ContainingOccurrence
    Catch ex As Exception
   		'MessageBox.Show("Problem getting occurrence for: " & partName, "iLogic")
    End Try
	
	'Define model geometry
    Dim oModelGeometry = oDrawCurveSeg.Parent.ModelGeometry
	
	'Define component definition
	Dim oCompDef As ComponentDefinition
    oCompDef = oModelGeometry.parent.componentdefinition

	'Get part name
	partName = oCompDef.Document.DisplayName
	'MessageBox.Show(partName & " selected.", "iLogic")
	
    'Get the drawing view
    Dim oDrwView As DrawingView
    oDrwView = oDrawCurve.Parent

	'Define oPart As String
	oPart = oCompDef.Document.DisplayName & ".ipt"

	'Declare AutoType, the part shape type to be calculated.
	Dim AutoType As String
	
	'Define Units of Measure
	Dim uom as UnitsOfMeasure = oDoc.UnitsOfMeasure	
	
	Dim minp As point
	Dim maxp As point
	
	'Declare the range box.
	Dim oRB As Box
	Try
		'Get the range box, aligned to part UCS, excluding work geometry.
		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
	
	Dim AutoName As String
	AutoName = "-"

		InventorVb.DocumentUpdate()
		
		Try
		oCheckFile = iProperties.Value(oPart, "Project", "Part Number")
		Catch
		MessageBox.Show("Error finding file 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)
				'MessageBox.Show("Extents: " & X & " : " & Y & " : "  & Z, "iLogic")
		'Sort dimensions from smallest to largest
		Dim extents As New ArrayList()
		extents.add(X)
		extents.add(Y)
		extents.add(Z)
		extents.Sort()
				'MessageBox.Show("Extents: " & extents(0) & " : " & extents(1) & " : "  & extents(2), "iLogic")
				
		'Assign dimensions
		Thickness = extents(0)
		Width = extents(1)
		Length = extents(2)
		
		'Get stock number properties (which are sometimes different to actual dimensions)
		Dim stockprops() As String
		Try
			stockprops = Split(iProperties.Value(oPart, "Project", "Stock Number"), "x")
		Catch
		End Try
		
		'Get classification for fasteners
		Dim stockclass() As String
		Try
			stockclass = Split(iProperties.Value(oPart, "Project", "Part Number"), "-")
			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(iProperties.Value(oPart, "Project", "Part Number"), "UNC") = 0 Then
			stand = " UNC"
			End If
			If Not InStr(iProperties.Value(oPart, "Project", "Part Number"), "UNF") = 0 Then
			stand = " UNF"
			End If
			Else
			stand = ""
			
			End If
		Catch
		End Try
		
		Try
		'Use part parameter named "Type", if it exists.
		'This can be used as an override for a part which is being wrongly assessed.
		AutoType = Parameter(oPart, "Type")
		Catch ex As Exception
		
			'Create a list of parameters to check for.
			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
					parametro = Parameter(oPart, param)
					params.Add(param)
					'MessageBox.Show(param & " = " & parametro, "iLogic")
				Catch
					'MessageBox.Show(param & " doesn't exist.", "iLogic")
				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
			'leave blank if no match is found.
			AutoType = ""
			End If

		End Try
		
		'Set Shape Type
		If AutoType = "" Then
		'Prompt for manual input - in format "PFC", "F BAR", "RD BAR", "UC", etc.
		oType = InputBox("Treat as:", "Part Type", AutoType)
		Else
		'Use automatically calculated type
		oType = AutoType
		End If
		
	
		'Create a default description
		Select Case UCase(oType)
		
		Case "PLATE"
		AutoName = "PLT " & Thickness & " THK " & Length & " x " & Width
		
		Case "F BAR"
		AutoName = "F/BAR " & Width & " x " & Thickness
		
		Case "CHS"
		Try 
		AutoName = "CHS " & Parameter(oPart, "G_H") & " OD x " & Parameter(oPart, "G_T") & " WT"
		Catch
		MessageBox.Show("Error getting parameters", "iLogic")
		AutoName = ""
		End Try
		
		Case "SHS", "RHS"
		Try
		'Distinguish between square and rectangular section
		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
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "RD BAR"
		Try 
		AutoName = "RD BAR DIA. " & Parameter(oPart, "G_H")
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "RSA"
		Try 
		AutoName = "RSA " & Parameter(oPart, "G_H") & " x " & Parameter(oPart, "G_W") & " x " & Parameter(oPart, "G_T")
		Catch
			Try 
			AutoName = "RSA " & Parameter(oPart, "b") & " x " & Parameter(oPart, "b") & " x " & Parameter(oPart, "ParT")
			Catch
				MessageBox.Show("Error getting parameters as " & oType, "iLogic")
				AutoName = ""
			End Try
		End Try
		
		Case "PFC"
		Try 
		AutoName = "PFC " & stockprops(0) & " x " & stockprops(1) & " x " & stockprops(2)
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try

		Case "UC", "UB"
		Try
		'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
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "BOLT"
		Try 
		AutoName = oClass & stand & " HEX BOLT"
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "NUT"
		Try 
		AutoName = oClass & stand & " HEX NUT"
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "WASHER"
		Try 
		AutoName = oClass & " FLAT WASHER, FORM A"
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "C SINK"
		Try 
		AutoName = oClass & stand & " COUNTERSINK SCREW"
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "SOCKET SCREW"
		Try 
		AutoName = oClass & stand & " SOCKET SCREW"
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case "GRUB"
		Try 
		AutoName = oClass & stand & " GRUB SCREW"
		Catch
		MessageBox.Show("Error getting parameters as " & oType, "iLogic")
		AutoName = ""
		End Try
		
		Case Else
		AutoName = ""
		End Select	
		
		'Show input box with default description
		oNewDescription = InputBox("Description for '" & partName & "':", "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