07-20-2017
12:03 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-20-2017
12:03 PM
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
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