07-21-2017
06:19 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-21-2017
06:19 AM
*There must be a better way than re-posting updates in full below all of the other versions. This is getting ridiculous.
Unfortunately, your code did not work.
I fixed the rule, and created a function to check if parameters exist as you suggested. It works great now and, thanks to your changes, even works for changing the description of standard content centre parts, which wasn't possible before.
Module mod1
Public oPart As String
End Module
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
'leave empty so that esc key cancels rule without pop-up.
'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
oPart = System.IO.Path.GetFileName(oSelectedModelDoc.FullFileName)
'Create a default description
AutoName = AutoDescriptionBasedonType(oSelectedModelDoc)
'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("Auto-Description")
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
If ParamsExist(1, "G_NG") Then
AutoType = "PFC"
ElseIf ParamsExist(1, "G_W", "G_T") And ParamsExist(0, "G_T1", "G_ER") Then
AutoType = "RHS"
ElseIf ParamsExist(1, "G_T") And ParamsExist(0, "G_W") Then
AutoType = "CHS"
ElseIf ParamsExist(1, "G_H") And ParamsExist(0, "G_T", "G_W") Then
AutoType = "RD BAR"
ElseIf ParamsExist(1, "G_T1") And ParamsExist(0, "G_NG") Then
AutoType = "UC"
ElseIf ParamsExist(1, "G_ER") Or ParamsExist(1, "b") Then
AutoType = "RSA"
ElseIf ParamsExist(1, "G_W") And ParamsExist(0, "G_T") Then
AutoType = "F BAR"
ElseIf ParamsExist(1, "NLG", "SW", "SD2") Then
AutoType = "BOLT"
ElseIf ParamsExist(1, "SW") And ParamsExist(0, "NLG") Then
AutoType = "NUT"
ElseIf ParamsExist(1, "SD2") And ParamsExist(0, "NLG") Then
AutoType = "WASHER"
ElseIf ParamsExist(1, "SEWI") Then
AutoType = "C SINK"
ElseIf ParamsExist(1, "KOD") And ParamsExist(0, "SEWI") Then
AutoType = "SOCKET SCREW"
ElseIf ParamsExist(1, "FAWI") Then
AutoType = "GRUB"
ElseIf ParamsExist(0, "B_L") Then
AutoType = "PLATE"
Else
AutoType = ""
End If
Return AutoType
End Function
Function ParamsExist(checkType As Integer, ByVal ParamArray paramstocheck As String()) As Boolean
For Each oParam in paramstocheck
'MessageBox.Show("Checking for: " & oParam, "iLogic")
Try
testparamexists = Parameter(oPart, oParam)
If checkType = 0 Then
Return False
End If
Catch
If checkType = 1 Then
Return False
End If
End Try
Next
Return True
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 & " SHCS"
Case "GRUB"
AutoName = oClass & stand & " GRUB SCREW"
Case Else
AutoName = ""
End Select
Catch
AutoName = ""
End Try
Return AutoName
End Function