diff --git a/CatiaNetTest/AndOrDataExtraction.vb b/CatiaNetTest/AndOrDataExtraction.vb new file mode 100644 index 0000000000000000000000000000000000000000..ce6bec4f319946779e1300d8152b21a7d4c8e921 --- /dev/null +++ b/CatiaNetTest/AndOrDataExtraction.vb @@ -0,0 +1,1310 @@ +Imports System +Imports HybridShapeTypeLib +Imports INFITF +Imports MECMOD +Imports NavigatorTypeLib +Imports ProductStructureTypeLib +Imports SPATypeLib +Imports PARTITF +Imports Microsoft.Office.Interop.Excel +Imports Microsoft.VisualBasic + +Public Class AndOrDataExtraction + + Public cAllProducts As New ArrayList + Public cRelevantProducts As New ArrayList + Public intParts As Integer + Public intNumFaces As Integer + Public primaryFasteners As New ArrayList + Public secondaryFasteners As New ArrayList + Public aRemovalDistances(,) As Double + Public aAssemblyBoundaries(5) As Double + Public aPartBBGlob(,) As Double + Public aInitPos(,) As Double + Public intStep As Integer + Public dCollSens As Double + Public MW_x_pos(,) As Integer + Public MW_y_pos(,) As Integer + Public MW_z_pos(,) As Integer + Public liaisonMatrix(,) As Integer + Public numEdges As Integer = 0 + Public hypergraph As New Dictionary(Of Integer, List(Of List(Of Integer))) + Public CATIA As INFITF.Application + + Sub CatMain() + + CATIA = GetObject(, "CATIA.Application") + If CATIA Is Nothing Then CATIA = CreateObject("CATIA.Application") + + Dim document As ProductDocument + document = CATIA.ActiveDocument + + Dim topProduct As Product + topProduct = document.Product + + 'Determine physical contacts (liaisons) between elementary parts and output to Excel + Liaison(topProduct) + + 'Determine moving wedge (MW) matrices of the product + MovingWedge() + + 'Create AND/OR graph + Dim prod As New List(Of Integer) + For i = 1 To cRelevantProducts.Count + prod.Add(i) + Next + Dim nodes As New List(Of List(Of Integer)) + 'Add the final product to the list of legal assemblies + nodes.Add(prod) + AndOrGraph(prod, nodes) + + Debug.Print("AND/OR nodes: " + CStr(nodes.Count)) + Debug.Print("AND/OR edges: " + CStr(numEdges)) + + End Sub + + Sub AndOrGraph(prod As List(Of Integer), nodes As List(Of List(Of Integer))) + 'Creates AND/OR graph in the form of a dictionary: + '{<index of hyperedge>: (<resulting subassembly>, <first subassembly>, <second subassembly>)} + + Dim n As Integer = prod.Count + Dim numSubdivisions As Long = Convert.ToInt64(2 ^ (n - 1)) + + 'Iterate over all possible assembly binary partitions + For p = 1 To numSubdivisions - 1 + Dim prt As New List(Of List(Of Integer)) + prt = BinaryPartition(p, n, prod) + Debug.Print(PrintIntegerList(prt(0)) & PrintIntegerList(prt(1))) + Dim l1 As Integer = prt(0).Count + Dim l2 As Integer = prt(1).Count + 'Check both subassemblies for connectedness + If SubassemblyIsConnected(prt(0)) = False Then + Continue For + End If + If SubassemblyIsConnected(prt(1)) = False Then + Continue For + End If + 'Check whether disassembly is possible by checking for + 'collision-free assembly paths of one of two subsets along all axes + Dim assemblyDirections As New List(Of Integer) + For i = 0 To 5 + Dim checksum As Integer = 0 + Dim matrix(,) As Integer + If i = 0 Or i = 3 Then + matrix = MW_x_pos + ElseIf i = 1 Or i = 4 Then + matrix = MW_y_pos + ElseIf i = 2 Or i = 5 Then + matrix = MW_z_pos + End If + For Each j In prt(0) + For Each k In prt(1) + If i < 3 Then + checksum += matrix(j - 1, k - 1) + Else + checksum += matrix(k - 1, j - 1) + End If + Next + Next + If checksum = l1 * l2 Then + assemblyDirections.Add(i) + End If + Next + If assemblyDirections.Count > 0 Then + Debug.Print(PrintIntegerList(prt(0)) & " can be assembled to " & PrintIntegerList(prt(1)) & " along directions " & PrintIntegerList(assemblyDirections)) + numEdges += 1 + 'Save hyperedge + Dim edge As New List(Of List(Of Integer)) + edge.Add(prod) + edge.Add(prt(0)) + edge.Add(prt(1)) + hypergraph.Add(numEdges, edge) + 'Continue AND/OR procedure for unvisited subassemblies (FindIndex will return -1 for such subassemblies) + Dim index0 = nodes.FindIndex(Function(node) node.SequenceEqual(prt(0))) + If index0 = -1 Then + nodes.Add(prt(0)) + AndOrGraph(prt(0), nodes) + End If + Dim index1 = nodes.FindIndex(Function(node) node.SequenceEqual(prt(1))) + If index1 = -1 Then + nodes.Add(prt(1)) + AndOrGraph(prt(1), nodes) + End If + End If + Next + + End Sub + + Function SubassemblyIsConnected(prt As List(Of Integer)) As Boolean + + 'List of visited nodes + Dim visitedNodes As New List(Of Boolean) + Dim prtCount As Integer = prt.Count + For x = 0 To prtCount - 1 + visitedNodes.Add(False) + Next + + 'Submatrix of liaison adjacency matrix that contains only the nodes of this subassembly + Dim liaisonSubmatrix(,) As Integer + ReDim liaisonSubmatrix(prtCount, prtCount) + For m = 0 To prtCount - 1 + For k = 0 To prtCount - 1 + liaisonSubmatrix(m, k) = liaisonMatrix(prt(m) - 1, prt(k) - 1) + Next + Next + + 'Depth-first search to explore the liaison subgraph from the first node + DFS(liaisonSubmatrix, visitedNodes, 0) + + 'Check whether all nodes could be visited via liaison connections + For i = 0 To prtCount - 1 + If visitedNodes(i) = False Then + Return False + End If + Next + + Return True + + End Function + + Sub DFS(liaisonSubmatrix(,) As Integer, visitedNodes As List(Of Boolean), v As Integer) + 'Depth-first search + + If visitedNodes(v) = True Then + Exit Sub + End If + + visitedNodes(v) = True + + 'Neighbors of v + Dim neighbors As New List(Of Integer) + For i = 0 To visitedNodes.Count - 1 + If liaisonSubmatrix(v, i) = 1 Then + neighbors.Add(i) + End If + Next + + 'Do DFS on all neighbor nodes if they were not visited + For Each u In neighbors + If visitedNodes(u) = False Then + DFS(liaisonSubmatrix, visitedNodes, u) + End If + Next + + End Sub + + Function BinaryPartition(index As Integer, n As Integer, prod As List(Of Integer)) As List(Of List(Of Integer)) + 'Uses binary representation of an integer to distribute elements in two sets (subassemblies) + + 'Marking elements of a list by 0 and 1 encodes the distribution to two sets + Dim bitmask As String = Convert.ToString(index, 2).PadLeft(n, "0"c) + + Dim sub0, sub1 As New List(Of Integer) + Dim j As Integer = 0 + For Each c As Char In bitmask + If c = "0"c Then + sub0.Add(prod(j)) + Else + sub1.Add(prod(j)) + End If + j += 1 + Next + + Dim binPartition As New List(Of List(Of Integer)) + binPartition.Add(sub0) + binPartition.Add(sub1) + Return binPartition + + End Function + + Function PrintIntegerList(list As List(Of Integer)) As String + + Dim str As String = "[" + For i = 0 To list.Count - 1 + If i = list.Count - 1 Then + str += CStr(list(i)) + "]" + Else + str += CStr(list(i)) + ", " + End If + Next + + Return str + + End Function + + Sub MovingWedge() + + 'Collision detection parameters + intStep = 10 + dCollSens = 2 + + 'access the clash technology object + Dim cClashes As Clashes + cClashes = CATIA.ActiveDocument.Product.GetTechnologicalObject("Clashes") + 'access the groups technology object + Dim cGroups As Groups + cGroups = CATIA.ActiveDocument.Product.GetTechnologicalObject("Groups") + + 'Distances from global axis system origin to assembly boundary (along global axis) + aAssemblyBoundaries(0) = -1 / 0 'max_X + aAssemblyBoundaries(1) = 1 / 0 'min_X + aAssemblyBoundaries(2) = -1 / 0 'max_Y + aAssemblyBoundaries(3) = 1 / 0 'min_Y + aAssemblyBoundaries(4) = -1 / 0 'max_Z + aAssemblyBoundaries(5) = 1 / 0 'min_Z + + 'Global coordinates, of which at least one has to be exceeded by the part origin, for that part to be "disassembled" + 'in global axis directions + ReDim aRemovalDistances(cRelevantProducts.Count - 1, 5) + aRemovalDistances(0, 0) = 0# 'X_pos + aRemovalDistances(0, 1) = 0# 'X_neg + aRemovalDistances(0, 2) = 0# 'Y_pos + aRemovalDistances(0, 3) = 0# 'Y_neg + aRemovalDistances(0, 4) = 0# 'Z_pos + aRemovalDistances(0, 5) = 0# 'Z_neg + + 'Store information about secondary BB (6 distances to boundary planes from part origin along global x/y/z directions) - used to define aRemovalDistances + 'Secondary BB: faces parallel to global origin planes and defined by outermost corner points of local BB of this part + ReDim aPartBBGlob(cRelevantProducts.Count - 1, 5) + aPartBBGlob(0, 0) = 0# 'x_part_glob_pos + aPartBBGlob(0, 1) = 0# 'x_part_glob_neg + aPartBBGlob(0, 2) = 0# 'y_part_glob_pos + aPartBBGlob(0, 3) = 0# 'y_part_glob_neg + aPartBBGlob(0, 4) = 0# 'z_part_glob_pos + aPartBBGlob(0, 5) = 0# 'z_part_glob_neg + + 'Initialize aPartBBGlob with safe values + For i = 0 To cRelevantProducts.Count - 1 + aPartBBGlob(i, 0) = -1 / 0 + aPartBBGlob(i, 1) = 1 / 0 + aPartBBGlob(i, 2) = -1 / 0 + aPartBBGlob(i, 3) = 1 / 0 + aPartBBGlob(i, 4) = -1 / 0 + aPartBBGlob(i, 5) = 1 / 0 + Next + + ReDim aInitPos(cRelevantProducts.Count - 1, 11) 'remember initial positions of the products + + For i = 0 To cRelevantProducts.Count - 1 + + '########## this won't work if part document name is not = part number ###### + ''Dim partI As Part + Dim prodI As Product + prodI = cRelevantProducts.Item(i) + Dim docName As String + docName = prodI.PartNumber + ".CATPart" + Debug.Print(">>> " & docName & " <<<") + GenerateBoundingBox(CATIA.Documents.Item(docName), prodI, i) + '############################################################################ + + 'Determine assembly 's limits + 'Dim partI As Part + 'Dim prodI As Product + 'prodI = cRelevantProducts.Item(i) + 'Dim docName As String + 'docName = prodI.PartNumber + ".CATPart" + 'Dim oPartDoc As PartDocument + 'Dim sPartPath As String + 'sPartPath = prodI.GetMasterShapeRepresentationPathName + 'oPartDoc = CATIA.Documents.Read(sPartPath) + 'Debug.Print(">>> " & docName & " <<<") + ''CATIA.Documents.Item(docName) + 'GenerateBoundingBox(oPartDoc, prodI, i) + + Next i + + 'After the aAssemblyBoundaries and aPartBBGlob are calculated, define aRemovalDistances + For i = 0 To cRelevantProducts.Count - 1 + aRemovalDistances(i, 0) = aAssemblyBoundaries(0) - aPartBBGlob(i, 1) + aRemovalDistances(i, 1) = aAssemblyBoundaries(1) - aPartBBGlob(i, 0) + aRemovalDistances(i, 2) = aAssemblyBoundaries(2) - aPartBBGlob(i, 3) + aRemovalDistances(i, 3) = aAssemblyBoundaries(3) - aPartBBGlob(i, 2) + aRemovalDistances(i, 4) = aAssemblyBoundaries(4) - aPartBBGlob(i, 5) + aRemovalDistances(i, 5) = aAssemblyBoundaries(5) - aPartBBGlob(i, 4) + Next i + + 'Clash analysis (every pair of products) + Dim int_i As Integer + Dim int_j As Integer + Dim n As Integer + n = cRelevantProducts.Count + Dim j As Integer + j = 6 + ReDim MW_x_pos(n, n) + ReDim MW_y_pos(n, n) + ReDim MW_z_pos(n, n) + + 'Remember initial position P_i (initPos) + Dim p As Product + For Each p In cRelevantProducts + Dim pInd As Integer + pInd = IndexOfProduct(p) + Dim initPos(11) + Dim oPosition As Object + oPosition = p.Position + oPosition.GetComponents(initPos) + Dim ip As Integer + For ip = 0 To 11 + aInitPos(pInd, ip) = initPos(ip) + Next ip + Next p + + 'Initialise MWs with 1 + For int_i = 1 To n + For int_j = 1 To n + MW_x_pos(int_i - 1, int_j - 1) = 1 + MW_y_pos(int_i - 1, int_j - 1) = 1 + MW_z_pos(int_i - 1, int_j - 1) = 1 + Next int_j + Next int_i + + For int_i = 1 To n + Dim prodI As Product + prodI = cRelevantProducts.Item(int_i - 1) + + 'compute clash between part i and all other parts + Dim group1 As Group + Dim group2 As Group + group1 = cGroups.Add + group2 = cGroups.Add + group1.AddExplicit(cRelevantProducts.Item(int_i - 1)) + For int_j = 1 To n + 'If BoundingBoxesOverlap(int_i - 1, int_j - 1) Then + group2.AddExplicit(cRelevantProducts.Item(int_j - 1)) + 'End If + Next int_j + + Dim d As Integer + For d = 0 To j - 1 + Do + moveProduct(prodI, d, True) + 'if disassembled, put part i back + If productReachedFinalPosition(prodI, int_i - 1) Then + Dim oPosition2 As Object + oPosition2 = prodI.Position + Dim initPosI2(11) + Dim ip2 As Integer + For ip2 = 0 To 11 + initPosI2(ip2) = aInitPos(int_i - 1, ip2) + Next ip2 + oPosition2.SetComponents(initPosI2) + Exit Do + End If + + 'reset as 0-index + int_j = 0 + 'create a new clash analysis + Dim oClash As Clash + oClash = cClashes.Add + oClash.ComputationType = CatClashComputationType.catClashComputationTypeBetweenTwo + oClash.FirstGroup = group1 + oClash.SecondGroup = group2 + oClash.InterferenceType = CatClashInterferenceType.catClashInterferenceTypeClearance + oClash.Compute() + Dim cConflicts As Conflicts + cConflicts = oClash.Conflicts + If cConflicts.Count > 0 Then + Dim oConflict As Conflict + Dim c As Integer + For c = 1 To cConflicts.Count + oConflict = cConflicts.Item(c) + oConflict.Status = CatConflictStatus.catConflictStatusRelevant + If oConflict.Type = CatConflictType.catConflictTypeClash Then + If oConflict.Value < -dCollSens Then + 'Debug.Print("Clash detected:") + 'Debug.Print(oConflict.FirstProduct.Name & " - " & oConflict.SecondProduct.Name & " = " & oConflict.Value) + int_j = IndexOfProduct(oConflict.SecondProduct) + 1 + If d = 0 Then + MW_x_pos(int_j - 1, int_i - 1) = 0 + End If + If d = 1 Then + MW_y_pos(int_j - 1, int_i - 1) = 0 + End If + If d = 2 Then + MW_z_pos(int_j - 1, int_i - 1) = 0 + End If + If d = 3 Then + MW_x_pos(int_i - 1, int_j - 1) = 0 + End If + If d = 4 Then + MW_y_pos(int_i - 1, int_j - 1) = 0 + End If + If d = 5 Then + MW_z_pos(int_i - 1, int_j - 1) = 0 + End If + + End If + End If + Next c + End If + Loop + Next d + Next int_i + + 'Use Excel + Dim oExcel As Microsoft.Office.Interop.Excel.Application + oExcel = CreateObject("Excel.Application") + oExcel.Visible = True + oExcel.Workbooks.Add() + oExcel.ActiveWorkbook.Sheets.Add.Name = "MW_z" + oExcel.ActiveWorkbook.Sheets.Add.Name = "MW_y" + oExcel.ActiveWorkbook.Sheets.Add.Name = "MW_x" + Dim objSheet1, objSheet2, objSheet3 As Object + objSheet1 = oExcel.ActiveWorkbook.Worksheets(1) + objSheet2 = oExcel.ActiveWorkbook.Worksheets(2) + objSheet3 = oExcel.ActiveWorkbook.Worksheets(3) + + 'Output MW matrices + For int_i = 1 To n + For int_j = 1 To n + objSheet1.Cells(int_i, int_j).Value = MW_x_pos(int_i - 1, int_j - 1) + objSheet2.Cells(int_i, int_j).Value = MW_y_pos(int_i - 1, int_j - 1) + objSheet3.Cells(int_i, int_j).Value = MW_z_pos(int_i - 1, int_j - 1) + Next int_j + Next int_i + + 'Save and close excel workbook + Dim xlsFileName As String = CATIA.ActiveDocument.Name + Dim xlsPath As String = "D:\mikep\Files\RWTH\Master Produktionstechnik\Masterarbeit\Experimente\" + oExcel.ActiveWorkbook.SaveAs(Filename:=xlsPath & xlsFileName & "_Moving wedge.xlsx") + oExcel.ActiveWorkbook.Close(SaveChanges:=True) + 'close the excel application + oExcel.Quit() + ReleaseObject(oExcel) + + End Sub + + Sub Liaison(theProduct As Product) + + 'Put the elementary parts on the deepest tree levels into cAllProducts list + ExtractProducts(theProduct, cAllProducts) + + Dim outputText As String + outputText = "This assembly contains " + CStr(cAllProducts.Count) + " parts (including fasteners)" + MsgBox(outputText) + + 'Put all parts from cAllProducts excluding fasteners into cRelevantProducts list + DeactivateFasteners(theProduct) + + Dim n As Integer = cRelevantProducts.Count + outputText = CStr(n) + " parts are considered in liaison graph generation" + MsgBox(outputText) + + ReDim liaisonMatrix(n, n) + + 'access the clash technology object + Dim cClashes As Clashes + cClashes = CATIA.ActiveDocument.Product.GetTechnologicalObject("Clashes") + 'access the groups technology object + Dim cGroups As Groups + cGroups = CATIA.ActiveDocument.Product.GetTechnologicalObject("Groups") + + 'Use Excel + Dim objExcel As Microsoft.Office.Interop.Excel.Application + objExcel = CreateObject("Excel.Application") + objExcel.Visible = True + objExcel.Workbooks.Add() + objExcel.ActiveWorkbook.Sheets.Add.Name = "Liaison Matrix" + Dim objSheet1 As Object + objSheet1 = objExcel.ActiveWorkbook.Worksheets(1) + + 'Clash analysis between all products (clash type = contact) + Dim int_i, int_j As Integer + For int_i = 1 To cRelevantProducts.Count + For int_j = 1 To cRelevantProducts.Count + If int_j > int_i Then 'only need one half of the combinations + Dim group1 As Group + Dim group2 As Group + group1 = cGroups.Add + group2 = cGroups.Add + group1.AddExplicit(cRelevantProducts.Item(int_i - 1)) + group2.AddExplicit(cRelevantProducts.Item(int_j - 1)) + 'create a new clash analysis + Dim oClash As Clash + oClash = cClashes.Add + oClash.ComputationType = CatClashComputationType.catClashComputationTypeBetweenTwo + oClash.FirstGroup = group1 + oClash.SecondGroup = group2 + oClash.InterferenceType = CatClashInterferenceType.catClashInterferenceTypeContact + oClash.Compute + Dim cConflicts As Conflicts + cConflicts = oClash.Conflicts + If cConflicts.Count > 0 Then + 'For each contact, write 1 in the spreadsheet + 'The matrix is symmetric and 0-diagonal + objSheet1.Cells(int_i, int_j).Value = 1 + liaisonMatrix(int_i - 1, int_j - 1) = 1 + objSheet1.Cells(int_j, int_i).Value = 1 + liaisonMatrix(int_j - 1, int_i - 1) = 1 + Else + objSheet1.Cells(int_i, int_j).Value = 0 + liaisonMatrix(int_i - 1, int_j - 1) = 0 + objSheet1.Cells(int_j, int_i).Value = 0 + liaisonMatrix(int_j - 1, int_i - 1) = 0 + End If + ElseIf int_j = int_i Then + objSheet1.Cells(int_i, int_j).Value = 0 + liaisonMatrix(int_i - 1, int_j - 1) = 0 + End If + Next int_j + Next int_i + + 'Save and close excel workbook + Dim xlsFileName As String = CATIA.ActiveDocument.Name + Dim xlsPath As String = "D:\mikep\Files\RWTH\Master Produktionstechnik\Masterarbeit\Experimente\" + objExcel.ActiveWorkbook.SaveAs(Filename:=xlsPath & xlsFileName & "_Liaisons.xlsx") + objExcel.ActiveWorkbook.Close(SaveChanges:=True) + 'close the excel application + objExcel.Quit() + ReleaseObject(objExcel) + + End Sub + + Function GenerateBoundingBox(partDocument1 As PartDocument, objProduct As Product, i As Integer) + 'Processes a single part to extract its origin XYZ, min/max X/Y/Z + + CATIA.DisplayFileAlerts = False + + 'Declare variables + Dim axis + Dim remake + Dim part1 As Part + Dim axisref As Object + Dim shapeFactory1 As ShapeFactory + Dim hybridShapeFactory1 As HybridShapeFactory + Dim sStatus As String + Dim hybridShapeD1, hybridShapeD2, hybridShapeD3 As HybridShapeDirection + Dim a1, a2, a3, a4, a5, a6 'To change the offsets of the box + Dim bodies1 As Bodies + Dim body1 As Body + Dim reference1 As Reference + Dim HybridShapeExtremum1, HybridShapeExtremum2, HybridShapeExtremum3 As HybridShapeExtremum + Dim HybridShapeExtremum4, HybridShapeExtremum5, HybridShapeExtremum6 As HybridShapeExtremum + Dim originCoord(2) + Dim faceSel As Object + + 'Check whether we are processing a Part + If (InStr(partDocument1.Name, ".CATPart")) <> 0 Then + part1 = partDocument1.Part + hybridShapeFactory1 = part1.HybridShapeFactory + + Dim axiscoord(2) + Dim axissyst + + Dim axisSystem As AxisSystem + axisSystem = part1.AxisSystems.Item(1) + + axissyst = axisSystem + axisref = axisSystem + + Dim ref_name_systaxis As String + ref_name_systaxis = axissyst.Name + + axissyst.IsCurrent = 1 + axissyst.Name = "BBoxAxis" + Dim axname As String + axname = axissyst.Name + + 'Get Product's Position (rotation and translation) + '(for now: relative to the parent product!) + Dim PositionArray(11) + Dim oPosition As Object + oPosition = objProduct.Position + oPosition.GetComponents(PositionArray) + + Dim originpoint As HybridShapePointCoord + axissyst.GetOrigin(originCoord) + 'MsgBox "X0 = " & CStr(originCoord(0)) & vbNewLine & "Y0 = " & CStr(originCoord(1)) & vbNewLine & "Z0 = " & CStr(originCoord(2)) + + originpoint = hybridShapeFactory1.AddNewPointCoord(originCoord(0), originCoord(1), originCoord(2)) + axisref = part1.CreateReferenceFromObject(originpoint) + axissyst.GetXAxis(axiscoord) + hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2)) + axissyst.GetYAxis(axiscoord) + hybridShapeD2 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2)) + axissyst.GetZAxis(axiscoord) + hybridShapeD3 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2)) + + 'hybridShapeD1&2 are not set yet, but used for line creation (from origin of the axis system) + Dim Plane_line_1 As HybridShapeLinePtDir + Plane_line_1 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD1, 0, 0, False) + Dim Plane_line_2 As HybridShapeLinePtDir + Plane_line_2 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD2, 0, 0, False) + + Dim oBodies As Bodies + oBodies = part1.Bodies + + 'J is defined to make unique names for Axis and the Body for the bounding box + Dim j As Integer + j = oBodies.Count + + 'Add new Body "Bounding Box."j to the Bodies of the current Part + bodies1 = part1.Bodies + body1 = bodies1.Add() + body1.Name = "Bounding Box." & j + + Dim hybridBodies1 As HybridBodies + hybridBodies1 = body1.HybridBodies + Dim hybridBody1 As HybridBody + hybridBody1 = hybridBodies1.Add + hybridBody1.Name = "definition_points" + + + 'Pick a face of the part to use for HybridShapeExtract + faceSel = CATIA.ActiveDocument.Selection + faceSel.Clear + 'The current Part is added to the selection + faceSel.Add(part1) + 'The selection gets rewritten by all the Faces of the selected part ("sel") + faceSel.Search("Type=Face,sel") + + Debug.Print("Selected faces: " & CStr(faceSel.Count)) + intNumFaces += faceSel.Count + + 'Need to check whether Extract crashes given this face and try the next one + Dim f As Integer + For f = 1 To faceSel.Count + + 'On Error GoTo ContinueFaceLoop + + reference1 = faceSel.Item(f).Value + Debug.Print(TypeName(reference1)) + + Dim hybridShapeExtract1 As HybridShapeExtract + hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1) + hybridShapeExtract1.PropagationType = 1 'point continuity + hybridShapeExtract1.ComplementaryExtract = False + hybridShapeExtract1.IsFederated = False + reference1 = hybridShapeExtract1 + + 'Create the 6 Extrenum items for the Solid/Surf. May not be single points, will be solved with next points + HybridShapeExtremum1 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD1, 1) + HybridShapeExtremum2 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD1, 0) + HybridShapeExtremum3 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD2, 1) + HybridShapeExtremum4 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD2, 0) + HybridShapeExtremum5 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD3, 1) + HybridShapeExtremum6 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD3, 0) + + ' Creates Geometrical Set under the Solid, to contain the construction elements + + Dim hybridBody2 As HybridBody + hybridBody2 = hybridBodies1.Item("definition_points") + + hybridBody2.AppendHybridShape(HybridShapeExtremum1) + part1.InWorkObject = HybridShapeExtremum1 + HybridShapeExtremum1.Name = "max_X" + hybridBody2.AppendHybridShape(HybridShapeExtremum2) + part1.InWorkObject = HybridShapeExtremum2 + HybridShapeExtremum2.Name = "min_X" + hybridBody2.AppendHybridShape(HybridShapeExtremum3) + part1.InWorkObject = HybridShapeExtremum3 + HybridShapeExtremum3.Name = "max_Y" + hybridBody2.AppendHybridShape(HybridShapeExtremum4) + part1.InWorkObject = HybridShapeExtremum4 + HybridShapeExtremum4.Name = "min_Y" + hybridBody2.AppendHybridShape(HybridShapeExtremum5) + part1.InWorkObject = HybridShapeExtremum5 + HybridShapeExtremum5.Name = "max_Z" + hybridBody2.AppendHybridShape(HybridShapeExtremum6) + part1.InWorkObject = HybridShapeExtremum6 + HybridShapeExtremum6.Name = "min_Z" + + part1.UpdateObject(HybridShapeExtremum1) + part1.UpdateObject(HybridShapeExtremum2) + part1.UpdateObject(HybridShapeExtremum3) + part1.UpdateObject(HybridShapeExtremum4) + part1.UpdateObject(HybridShapeExtremum5) + part1.UpdateObject(HybridShapeExtremum6) + + 'part1.Update + + ' Creates a 6 single points using the Extrenums as refs, so if the Extrenum was a line or surf, you can still off planes to these points + + Dim Ref1 As Reference + Ref1 = part1.CreateReferenceFromObject(HybridShapeExtremum1) + Dim Point1 As HybridShapePointCoord + Point1 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref1) + hybridBody2.AppendHybridShape(Point1) + Dim point_ref11 As Reference + point_ref11 = part1.CreateReferenceFromObject(Point1) + + Dim Ref2 As Reference + Ref2 = part1.CreateReferenceFromObject(HybridShapeExtremum2) + Dim Point2 As HybridShapePointCoord + Point2 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref2) + hybridBody2.AppendHybridShape(Point2) + Dim point_ref12 As Reference + point_ref12 = part1.CreateReferenceFromObject(Point2) + + Dim Ref3 As Reference + Ref3 = part1.CreateReferenceFromObject(HybridShapeExtremum3) + Dim Point3 As HybridShapePointCoord + Point3 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref3) + hybridBody2.AppendHybridShape(Point3) + Dim point_ref13 As Reference + point_ref13 = part1.CreateReferenceFromObject(Point3) + + Dim Ref4 As Reference + Ref4 = part1.CreateReferenceFromObject(HybridShapeExtremum4) + Dim Point4 As HybridShapePointCoord + Point4 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref4) + hybridBody2.AppendHybridShape(Point4) + Dim point_ref14 As Reference + point_ref14 = part1.CreateReferenceFromObject(Point4) + + Dim Ref5 As Reference + Ref5 = part1.CreateReferenceFromObject(HybridShapeExtremum5) + Dim Point5 As HybridShapePointCoord + Point5 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref5) + hybridBody2.AppendHybridShape(Point5) + Dim point_ref5 As Reference + point_ref5 = part1.CreateReferenceFromObject(Point5) + + Dim Ref6 As Reference + Ref6 = part1.CreateReferenceFromObject(HybridShapeExtremum6) + Dim Point6 As HybridShapePointCoord + Point6 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref6) + hybridBody2.AppendHybridShape(Point6) + Dim point_ref6 As Reference + point_ref6 = part1.CreateReferenceFromObject(Point6) + + part1.UpdateObject(Point1) + part1.UpdateObject(Point2) + part1.UpdateObject(Point3) + part1.UpdateObject(Point4) + part1.UpdateObject(Point5) + part1.UpdateObject(Point6) + + 'part1.Update + + axissyst.IsCurrent = 1 + + 'Read extremum coordinates + Dim coord(2) As Object + Dim absCoord(2) As Object + + Dim TheSPAWorkbench As Workbench + TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") + + Dim TheMeasurable + + Debug.Print("Extremum coordinates in the local Axis System:") + + 'Transform local extrema coordinates into global coordinates and update aAssemblyBoundaries + + 'Distances to Part Bounding Box faces in local coordinates + Dim aBBDistances(5) As Double + '8 corner points of the Part Bounding Box (BB) in local coordinates (8x3 array) + Dim aBBCornersLocal(7, 2) As Double + + 'max_X_loc + TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref11) + TheMeasurable.GetPoint(coord) + aBBDistances(0) = coord(0) + absCoord = {0.0, 0.0, 0.0} + Call Coord_Transform(coord, absCoord, objProduct, True) + Debug.Print(Point1.Name & " (" & Ref1.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]") + + 'min_X_loc + TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref12) + TheMeasurable.GetPoint(coord) + aBBDistances(1) = coord(0) + absCoord = {0.0, 0.0, 0.0} + Call Coord_Transform(coord, absCoord, objProduct, True) + Debug.Print(Point2.Name & " (" & Ref2.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]") + + 'max_Y_loc + TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref13) + TheMeasurable.GetPoint(coord) + aBBDistances(2) = coord(1) + absCoord = {0.0, 0.0, 0.0} + Call Coord_Transform(coord, absCoord, objProduct, True) + Debug.Print(Point3.Name & " (" & Ref3.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]") + + 'min_Y_loc + TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref14) + TheMeasurable.GetPoint(coord) + aBBDistances(3) = coord(1) + absCoord = {0.0, 0.0, 0.0} + Call Coord_Transform(coord, absCoord, objProduct, True) + Debug.Print(Point4.Name & " (" & Ref4.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]") + + 'max_Z_loc + TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref5) + TheMeasurable.GetPoint(coord) + aBBDistances(4) = coord(2) + absCoord = {0.0, 0.0, 0.0} + Call Coord_Transform(coord, absCoord, objProduct, True) + Debug.Print(Point5.Name & " (" & Ref5.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]") + + 'min_Z_loc + TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref6) + TheMeasurable.GetPoint(coord) + aBBDistances(5) = coord(2) + absCoord = {0.0, 0.0, 0.0} + Call Coord_Transform(coord, absCoord, objProduct, True) + Debug.Print(Point6.Name & " (" & Ref6.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]") + + 'Generate 8 corner points (local coordinates) to the aBBCornersLocal + Dim m, n, k, c As Integer + c = 0 + For m = 0 To 1 + For n = 2 To 3 + For k = 4 To 5 + aBBCornersLocal(c, 0) = aBBDistances(m) + aBBCornersLocal(c, 1) = aBBDistances(n) + aBBCornersLocal(c, 2) = aBBDistances(k) + 'Transform corner point into global coordinates + coord(0) = aBBCornersLocal(c, 0) + coord(1) = aBBCornersLocal(c, 1) + coord(2) = aBBCornersLocal(c, 2) + Call Coord_Transform(coord, absCoord, objProduct, True) + 'Record values to aPartBBGlob + Dim CCC(2) As Double 'Corner Coordinates in axis system Congruent to global but in the part's origin + CCC(0) = absCoord(0) - PositionArray(9) + CCC(1) = absCoord(1) - PositionArray(10) + CCC(2) = absCoord(2) - PositionArray(11) + If CCC(0) > aPartBBGlob(i, 0) Then + aPartBBGlob(i, 0) = CCC(0) + End If + If CCC(0) < aPartBBGlob(i, 1) Then + aPartBBGlob(i, 1) = CCC(0) + End If + If CCC(1) > aPartBBGlob(i, 2) Then + aPartBBGlob(i, 2) = CCC(1) + End If + If CCC(1) < aPartBBGlob(i, 3) Then + aPartBBGlob(i, 3) = CCC(1) + End If + If CCC(2) > aPartBBGlob(i, 4) Then + aPartBBGlob(i, 4) = CCC(2) + End If + If CCC(2) < aPartBBGlob(i, 5) Then + aPartBBGlob(i, 5) = CCC(2) + End If + 'Update aAssemblyBoundaries (global) + If absCoord(0) > aAssemblyBoundaries(0) Then + aAssemblyBoundaries(0) = absCoord(0) + End If + If absCoord(0) < aAssemblyBoundaries(1) Then + aAssemblyBoundaries(1) = absCoord(0) + End If + If absCoord(1) > aAssemblyBoundaries(2) Then + aAssemblyBoundaries(2) = absCoord(1) + End If + If absCoord(1) < aAssemblyBoundaries(3) Then + aAssemblyBoundaries(3) = absCoord(1) + End If + If absCoord(2) > aAssemblyBoundaries(4) Then + aAssemblyBoundaries(4) = absCoord(2) + End If + If absCoord(2) < aAssemblyBoundaries(5) Then + aAssemblyBoundaries(5) = absCoord(2) + End If + c = c + 1 + Next k + Next n + Next m + + part1.Update() + + Exit For + + 'ContinueFaceLoop: + + Next f + + Else + MsgBox("The active document must be a CATPart") + End If + + End Function + + Sub ExtractProducts(oCurrentProduct As Product, cElementaryParts As ArrayList) + + Dim oCurrentTreeNode As Product + Dim i As Integer + + If oCurrentProduct.Products.Count = 0 Then + cElementaryParts.Add(oCurrentProduct) + End If + + For i = 1 To oCurrentProduct.Products.Count + oCurrentTreeNode = oCurrentProduct.Products.Item(i) + + 'recursive + If oCurrentTreeNode.Products.Count > 0 Then + ExtractProducts(oCurrentTreeNode, cElementaryParts) + Else + Debug.Print(oCurrentTreeNode.PartNumber & " (" & oCurrentTreeNode.Name & ") is a leaf product") + 'remove special characters from the part number + Dim newPartNo As String + Dim newCharacter As String + newCharacter = " " + newPartNo = oCurrentTreeNode.PartNumber + newPartNo = Replace(newPartNo, "<", newCharacter) + newPartNo = Replace(newPartNo, ">", newCharacter) + newPartNo = Replace(newPartNo, "/", newCharacter) + oCurrentTreeNode.PartNumber = newPartNo + cElementaryParts.Add(oCurrentTreeNode) + End If + + Next + + End Sub + + Function DeactivateFasteners(objProduct As Product) + + Dim objParts As INFITF.Collection + 'On the top level of product tree + objParts = objProduct.Products + 'Recursive + 'objParts = cAllProducts + Dim selection1 As Selection + selection1 = CATIA.ActiveDocument.Selection + selection1.Clear() + + Dim intFasteners As Integer + intFasteners = 0 + + For Each prod In objParts + Dim sName As String + Dim primFastSize As Integer + + sName = LCase(prod.PartNumber) + 'Debug.Print sName + If InStr(sName, "bolt") > 0 Then + Debug.Print(prod.Name + " was identified as a bolt") + selection1.Add(prod) + + primaryFasteners.Add(prod) + + CATIA.StartCommand("Activate / Deactivate Component") + selection1.Clear() + intFasteners = intFasteners + 1 + ElseIf InStr(sName, "screw") > 0 Or InStr(sName, "schraube") > 0 Or (InStr(sName, "iso") > 0 And InStr(sName, "4762") > 0) Or (InStr(sName, "din") > 0 And (InStr(sName, "912") > 0 Or InStr(sName, "933") > 0)) Then + Debug.Print(prod.Name + " was identified as a screw") + selection1.Add(prod) + + primaryFasteners.Add(prod) + + CATIA.StartCommand("Activate / Deactivate Component") + selection1.Clear() + intFasteners = intFasteners + 1 + ElseIf InStr(sName, "clip") > 0 Then + Debug.Print(prod.Name + " was identified as a clip") + selection1.Add(prod) + + primaryFasteners.Add(prod) + + CATIA.StartCommand("Activate / Deactivate Component") + selection1.Clear() + intFasteners = intFasteners + 1 + ElseIf InStr(sName, "wedge") > 0 Then + Debug.Print(prod.Name + " was identified as a wedge") + selection1.Add(prod) + + primaryFasteners.Add(prod) + + CATIA.StartCommand("Activate / Deactivate Component") + selection1.Clear() + intFasteners = intFasteners + 1 + 'ElseIf InStr(sName, "pin") > 0 Then + ' Debug.Print(prod.Name + " was identified as a pin") + ' selection1.Add(prod) + + ' primaryFasteners.Add(prod) + + ' CATIA.StartCommand("Activate / Deactivate Component") + ' selection1.Clear() + ' intFasteners = intFasteners + 1 + ElseIf InStr(sName, "nut") > 0 Or (InStr(sName, "iso") > 0 And InStr(sName, "4161") > 0) Or (InStr(sName, "din") > 0 And (InStr(sName, "934") > 0 Or InStr(sName, "439") > 0)) Then + Debug.Print(prod.Name + " was identified as a nut") + selection1.Add(prod) + + secondaryFasteners.Add(prod) + + CATIA.StartCommand("Activate / Deactivate Component") + selection1.Clear() + intFasteners = intFasteners + 1 + ElseIf InStr(sName, "washer") > 0 Or (InStr(sName, "din") > 0 And (InStr(sName, "9021") > 0 Or InStr(sName, "125") > 0 Or InStr(sName, "127") > 0)) Then + Debug.Print(prod.Name + " was identified as a washer") + selection1.Add(prod) + + secondaryFasteners.Add(prod) + + CATIA.StartCommand("Activate / Deactivate Component") + selection1.Clear() + intFasteners = intFasteners + 1 + Else + cRelevantProducts.Add(prod) + End If + Next + + Debug.Print("Deactivated " + CStr(intFasteners) + " fasteners") + + MsgBox("Fasteners are deacivated. Press OK to proceed.") + + End Function + + Private Sub ReleaseObject(ByVal obj As Object) + Try + Dim intRel As Integer = 0 + Do + intRel = System.Runtime.InteropServices.Marshal.ReleaseComObject(obj) + Loop While intRel > 0 + 'MsgBox("Final Released obj # " & intRel) + Catch ex As Exception + MsgBox("Error releasing object" & ex.ToString) + obj = Nothing + Finally + GC.Collect() + End Try + End Sub + + Function Det3x3(dX11 As Double, dX12 As Double, dX13 As Double, + dX21 As Double, dX22 As Double, dX23 As Double, + dX31 As Double, dX32 As Double, dX33 As Double) As Double + '*********************************************** + '* + '* 3x3 matrix determinant calculation (direct) + '* + '*********************************************** + + Det3x3 = dX11 * dX22 * dX33 + dX12 * dX23 * dX31 + dX21 * dX32 * dX13 - + dX13 * dX22 * dX31 - dX12 * dX21 * dX33 - dX23 * dX32 * dX11 + End Function + Function Inv3x3(dX11 As Double, dX12 As Double, dX13 As Double, + dX21 As Double, dX22 As Double, dX23 As Double, + dX31 As Double, dX32 As Double, dX33 As Double, aInv() As Double) As Double() + '*********************************************** + '* + '* 3x3 matrix inverse calculation (direct) + '* + '*********************************************** + Dim dDet As Double + + ReDim aInv(8) + + dDet = Det3x3(dX11, dX12, dX13, dX21, dX22, dX23, dX31, dX32, dX33) + 'If dDet = 0 Then Exit Function + If dDet = 0 Then Return Nothing + + aInv(0) = (dX22 * dX33 - dX23 * dX32) / Math.Abs(dDet) + aInv(1) = (dX13 * dX32 - dX12 * dX33) / Math.Abs(dDet) + aInv(2) = (dX12 * dX23 - dX13 * dX22) / Math.Abs(dDet) + aInv(3) = (dX23 * dX31 - dX21 * dX33) / Math.Abs(dDet) + aInv(4) = (dX11 * dX33 - dX13 * dX31) / Math.Abs(dDet) + aInv(5) = (dX13 * dX21 - dX11 * dX23) / Math.Abs(dDet) + aInv(6) = (dX21 * dX32 - dX22 * dX31) / Math.Abs(dDet) + aInv(7) = (dX12 * dX31 - dX11 * dX32) / Math.Abs(dDet) + aInv(8) = (dX11 * dX22 - dX12 * dX21) / Math.Abs(dDet) + + Return aInv + + End Function + Sub Coord_Transform(aRel() As Object, aAbs() As Object, oProduct As Product, bRecursively As Boolean) + + Dim vProduct As Object, vCoord(11) + Dim oFatherProduct As Product + Dim aInv(8) As Double + + 'Exit condition, empty object + If oProduct Is Nothing Then Exit Sub + + 'Redim absolute coords matrix + On Error Resume Next + 'aAbs = {0.0, 0.0, 0.0} + On Error GoTo 0 + + 'Calculate product coordinates + vProduct = oProduct + vProduct.Position.GetComponents(vCoord) + + 'Calculate inverse matrix + If IsNothing(Inv3x3(CDbl(vCoord(0)), CDbl(vCoord(1)), CDbl(vCoord(2)), + CDbl(vCoord(3)), CDbl(vCoord(4)), CDbl(vCoord(5)), + CDbl(vCoord(6)), CDbl(vCoord(7)), CDbl(vCoord(8)), aInv)) Then + 'MsgBox "Error, degenerate transformation", vbOKOnly + Exit Sub + Else + aInv = Inv3x3(CDbl(vCoord(0)), CDbl(vCoord(1)), CDbl(vCoord(2)), + CDbl(vCoord(3)), CDbl(vCoord(4)), CDbl(vCoord(5)), + CDbl(vCoord(6)), CDbl(vCoord(7)), CDbl(vCoord(8)), aInv) + End If + + 'Calculate transformation + aAbs(0) = vCoord(9) + aInv(0) * aRel(0) + aInv(1) * aRel(1) + aInv(2) * aRel(2) + aAbs(1) = vCoord(10) + aInv(3) * aRel(0) + aInv(4) * aRel(1) + aInv(5) * aRel(2) + aAbs(2) = vCoord(11) + aInv(6) * aRel(0) + aInv(7) * aRel(1) + aInv(8) * aRel(2) + + 'If recursive option sepecified, search for parents and applies the transformation again + If bRecursively Then + + 'Try to assign parent + oFatherProduct = Nothing + On Error Resume Next + oFatherProduct = oProduct.Parent.Parent + On Error GoTo 0 + + 'If OK, recalculate coords + If oFatherProduct Is Nothing Then + Else + If oFatherProduct.PartNumber + ".CATProduct" = CATIA.ActiveDocument.Name Then + aRel(0) = aAbs(0) + aRel(1) = aAbs(1) + aRel(2) = aAbs(2) + Coord_Transform(aRel, aAbs, oFatherProduct, False) + Else + aRel(0) = aAbs(0) + aRel(1) = aAbs(1) + aRel(2) = aAbs(2) + Coord_Transform(aRel, aAbs, oFatherProduct, True) + End If + End If + + End If + + End Sub + + Function IndexOfProduct(objProd As Product) As Integer + Dim dummyObj As Product + Dim index As Integer + index = 0 + For Each dummyObj In cRelevantProducts + If dummyObj.Name = objProd.Name Then + Return index + End If + index = index + 1 + Next + End Function + + Sub moveProduct(objProd As Product, intDir As Integer, bPositive As Boolean) + Dim intS As Integer + If bPositive = True Then + intS = intStep + Else + intS = -intStep + End If + Dim moveArray(11) + moveArray(0) = 1 + moveArray(1) = 0 + moveArray(2) = 0 + moveArray(3) = 0 + moveArray(4) = 1 + moveArray(5) = 0 + moveArray(6) = 0 + moveArray(7) = 0 + moveArray(8) = 1 + moveArray(9) = 0 + moveArray(10) = 0 + moveArray(11) = 0 + + Dim axisArray(11) + + 'movement along global axis + If intDir < 6 Then + 'Attention: for now it is assumed that all products are on the top level of specification tree + If intDir = 0 Then + moveArray(9) = intS + End If + If intDir = 1 Then + moveArray(10) = intS + End If + If intDir = 2 Then + moveArray(11) = intS + End If + If intDir = 3 Then + moveArray(9) = -intS + End If + If intDir = 4 Then + moveArray(10) = -intS + End If + If intDir = 5 Then + moveArray(11) = -intS + End If + Else 'movement along local axis + Dim oPosition As Object + oPosition = objProd.Position + oPosition.GetComponents(axisArray) + If intDir = 6 Then + moveArray(9) = axisArray(0) * intS + moveArray(10) = axisArray(1) * intS + moveArray(11) = axisArray(2) * intS + End If + If intDir = 7 Then + moveArray(9) = axisArray(3) * intS + moveArray(10) = axisArray(4) * intS + moveArray(11) = axisArray(5) * intS + End If + If intDir = 8 Then + moveArray(9) = axisArray(6) * intS + moveArray(10) = axisArray(7) * intS + moveArray(11) = axisArray(8) * intS + End If + If intDir = 9 Then + moveArray(9) = -axisArray(0) * intS + moveArray(10) = -axisArray(1) * intS + moveArray(11) = -axisArray(2) * intS + End If + If intDir = 10 Then + moveArray(9) = -axisArray(3) * intS + moveArray(10) = -axisArray(4) * intS + moveArray(11) = -axisArray(5) * intS + End If + If intDir = 11 Then + moveArray(9) = -axisArray(6) * intS + moveArray(10) = -axisArray(7) * intS + moveArray(11) = -axisArray(8) * intS + End If + End If + Dim prod1nd As Product + prod1nd = objProd + prod1nd.Move.Apply(moveArray) + + End Sub + + Function BoundingBoxesOverlap(int_i As Integer, iStaticProduct As Integer) As Boolean + If aPartBBGlob(int_i, 1) >= aPartBBGlob(iStaticProduct, 0) Or aPartBBGlob(int_i, 0) <= aPartBBGlob(iStaticProduct, 1) Then + If aPartBBGlob(int_i, 3) >= aPartBBGlob(iStaticProduct, 2) Or aPartBBGlob(int_i, 2) <= aPartBBGlob(iStaticProduct, 3) Then + If aPartBBGlob(int_i, 5) >= aPartBBGlob(iStaticProduct, 4) Or aPartBBGlob(int_i, 4) <= aPartBBGlob(iStaticProduct, 5) Then + Return False + End If + End If + End If + Return True + End Function + + Function productReachedFinalPosition(objProd As Product, i1 As Integer) As Boolean + productReachedFinalPosition = False + Dim posArray(11) + Dim oPosition As Object + oPosition = objProd.Position + oPosition.GetComponents(posArray) + If posArray(9) > aRemovalDistances(i1, 0) Then + productReachedFinalPosition = True + 'MsgBox "X+ removal distance reached by " & objProd.Name + End If + If posArray(9) < aRemovalDistances(i1, 1) Then + productReachedFinalPosition = True + 'MsgBox "X- removal distance reached by " & objProd.Name + End If + If posArray(10) > aRemovalDistances(i1, 2) Then + productReachedFinalPosition = True + 'MsgBox "Y+ removal distance reached by " & objProd.Name + End If + If posArray(10) < aRemovalDistances(i1, 3) Then + productReachedFinalPosition = True + 'MsgBox "Y- removal distance reached by " & objProd.Name + End If + If posArray(11) > aRemovalDistances(i1, 4) Then + productReachedFinalPosition = True + 'MsgBox "Z+ removal distance reached by " & objProd.Name + End If + If posArray(11) < aRemovalDistances(i1, 5) Then + productReachedFinalPosition = True + 'MsgBox "Z- removal distance reached by " & objProd.Name + End If + End Function + +End Class diff --git a/CatiaNetTest/CatiaNetTest.vbproj b/CatiaNetTest/CatiaNetTest.vbproj index 36b6adaf1f53f4d1a70483349b728cc2c2ac1b3c..9ae2bfb7dd98e22ff43ca1c5c210655c2415e5ac 100644 --- a/CatiaNetTest/CatiaNetTest.vbproj +++ b/CatiaNetTest/CatiaNetTest.vbproj @@ -73,6 +73,7 @@ <Import Include="System.Threading.Tasks" /> </ItemGroup> <ItemGroup> + <Compile Include="AndOrDataExtraction.vb" /> <Compile Include="AssemblyTiers2.vb" /> <Compile Include="Form1.vb"> <SubType>Form</SubType> diff --git a/CatiaNetTest/Form1.vb b/CatiaNetTest/Form1.vb index 905540142b24b0c93471bb172395ea9b37253cc1..8fe82d64edd9f3febd8d9a049e64500c76b49906 100644 --- a/CatiaNetTest/Form1.vb +++ b/CatiaNetTest/Form1.vb @@ -35,7 +35,7 @@ Public Class Form1 Try myAssemblyTiers.CatMain() Catch ex As Exception - + Debug.WriteLine(ex.ToString()) End Try End Sub @@ -51,7 +51,19 @@ Public Class Form1 Try hierarchicalAlgorithm.CatMain() Catch ex As Exception + Debug.WriteLine(ex.ToString()) + End Try + End Sub + + Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click + Dim andOrAlgorithm As AndOrDataExtraction = New AndOrDataExtraction() + + Try + andOrAlgorithm.CatMain() + Catch ex As Exception + Debug.WriteLine(ex.ToString()) End Try End Sub + End Class diff --git a/CatiaNetTest/bin/Debug/CatiaNetTest.exe b/CatiaNetTest/bin/Debug/CatiaNetTest.exe index fa991fb5175975f1cdbde8fe6a0c9800d804d76f..6831f4de9d7aa37f0171ea57245af57abe0e8f20 100644 Binary files a/CatiaNetTest/bin/Debug/CatiaNetTest.exe and b/CatiaNetTest/bin/Debug/CatiaNetTest.exe differ diff --git a/CatiaNetTest/bin/Debug/CatiaNetTest.pdb b/CatiaNetTest/bin/Debug/CatiaNetTest.pdb index 5dfd60943eb0b41beaad1d9baf7ba04a2a5823cb..8a459496ce726433a93890ed6461cd883cd898ae 100644 Binary files a/CatiaNetTest/bin/Debug/CatiaNetTest.pdb and b/CatiaNetTest/bin/Debug/CatiaNetTest.pdb differ diff --git a/CatiaNetTest/obj/Debug/CatiaNetTest.exe b/CatiaNetTest/obj/Debug/CatiaNetTest.exe index fa991fb5175975f1cdbde8fe6a0c9800d804d76f..6831f4de9d7aa37f0171ea57245af57abe0e8f20 100644 Binary files a/CatiaNetTest/obj/Debug/CatiaNetTest.exe and b/CatiaNetTest/obj/Debug/CatiaNetTest.exe differ diff --git a/CatiaNetTest/obj/Debug/CatiaNetTest.pdb b/CatiaNetTest/obj/Debug/CatiaNetTest.pdb index 5dfd60943eb0b41beaad1d9baf7ba04a2a5823cb..8a459496ce726433a93890ed6461cd883cd898ae 100644 Binary files a/CatiaNetTest/obj/Debug/CatiaNetTest.pdb and b/CatiaNetTest/obj/Debug/CatiaNetTest.pdb differ diff --git a/CatiaNetTest/obj/Debug/CatiaNetTest.vbprojAssemblyReference.cache b/CatiaNetTest/obj/Debug/CatiaNetTest.vbprojAssemblyReference.cache index 98ac912058021e08fe3a1b745a79cf7499d688b6..4788ac6375fce3d9e11ed6d39b91e57428ed94aa 100644 Binary files a/CatiaNetTest/obj/Debug/CatiaNetTest.vbprojAssemblyReference.cache and b/CatiaNetTest/obj/Debug/CatiaNetTest.vbprojAssemblyReference.cache differ diff --git a/CatiaNetTest/obj/Debug/DesignTimeResolveAssemblyReferences.cache b/CatiaNetTest/obj/Debug/DesignTimeResolveAssemblyReferences.cache index 20323601aaea24770b5ca260161b363f78dd2615..bc53cc6643fca0a22d48b617443ff303418c309c 100644 Binary files a/CatiaNetTest/obj/Debug/DesignTimeResolveAssemblyReferences.cache and b/CatiaNetTest/obj/Debug/DesignTimeResolveAssemblyReferences.cache differ