07-20-2017
01:35 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
07-20-2017
01:35 AM
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