05-08-2017
08:32 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
05-08-2017
08:32 AM
An update to make it better at recognizing plate.
'Code to modify a part's description iPorperty based on shape. '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 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 oModelGeom = oDrawCurve.ModelGeometry 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 '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 largest to smallest Thickness = MinOfMany(X, Y, Z) Length = MaxOfMany(X, Y, Z) Width = X If Thickness = X Or Length = X Then Width = Y If Thickness = Y Or Length = Y Then Width = Z End If End If '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 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 'Test for parameters Try parametro = Parameter(oPart, "G_NG") G_NG = 1 Catch G_NG = 0 End Try Try parametro = Parameter(oPart, "G_T") G_T = 1 Catch G_T = 0 End Try Try parametro = Parameter(oPart, "G_W") G_W = 1 Catch G_W = 0 End Try Try parametro = Parameter(oPart, "G_ER") G_ER = 1 Catch G_ER = 0 End Try Try parametro = Parameter(oPart, "G_T1") G_T1 = 1 Catch G_T1 = 0 End Try Try parametro = Parameter(oPart, "G_H") G_H = 1 Catch G_H = 0 End Try 'Compare to expected parameters If G_NG = 1 Then AutoType = "PFC" ElseIf G_T1 = 0 And G_W = 1 And G_ER = 0 And G_T = 1 Then AutoType = "RHS" ElseIf G_T = 1 And G_W = 0 Then AutoType = "CHS" ElseIf G_T = 0 And G_W = 0 And G_H = 1 Then AutoType = "RD BAR" ElseIf G_T1 = 1 And G_NG = 0 Then AutoType = "UC" ElseIf G_ER = 1 Then AutoType = "RSA" ElseIf G_W = 1 And G_T = 0 Then AutoType = "F BAR" ElseIf G_H = 0 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 MessageBox.Show("Error getting parameters as " & oType, "iLogic") AutoName = "" 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 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