diff --git a/CatiaNetTest/AssemblyTiers2.vb b/CatiaNetTest/AssemblyTiers2.vb
index 2089e30e2f58d6fe7e113a6669fb996b693137dd..cb54f91d2f3f3f38dbac3301948abe0db8938c94 100644
--- a/CatiaNetTest/AssemblyTiers2.vb
+++ b/CatiaNetTest/AssemblyTiers2.vb
@@ -13,6 +13,7 @@ Public Class AssemblyTiers2
Public intStep As Integer
Public dCollSens As Double
Public intParts As Integer
+ Public intNumFaces As Integer
Public primaryFasteners As New ArrayList
Public secondaryFasteners As New ArrayList
Public cAllProducts As New ArrayList
@@ -72,13 +73,6 @@ Public Class AssemblyTiers2
oSel.Clear()
baseSel.Clear
- 'Collision parameters
- intStep = 10
- dCollSens = 2
- 'CollisionParams.Show
- Debug.Print("Step = " + CStr(intStep))
- Debug.Print("Sensitivity = " + CStr(dCollSens))
-
'Separation of components
DeactivateFasteners(document.Product)
@@ -87,12 +81,12 @@ Public Class AssemblyTiers2
MsgBox(outputText)
'Distances from global axis system origin to assembly boundary (along global axis)
- aAssemblyBoundaries(0) = 0# 'max_X
- aAssemblyBoundaries(1) = 0# 'min_X
- aAssemblyBoundaries(2) = 0# 'max_Y
- aAssemblyBoundaries(3) = 0# 'min_Y
- aAssemblyBoundaries(4) = 0# 'max_Z
- aAssemblyBoundaries(5) = 0# 'min_Z
+ 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
@@ -114,16 +108,29 @@ Public Class AssemblyTiers2
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
+
Dim BBStartTime As DateTime
BBStartTime = Now
'This is used to check whether a product must be moved in current iteration
Dim bMoveable(cRelevantProducts.Count - 1) As Boolean
+ 'Number of faces in assembly represents the geometrical complexity of parts
+ intNumFaces = 0
+
For i = 0 To cRelevantProducts.Count - 1
'########## this won't work if part document name is not = part number ######
- 'Dim partI As Part
+ ''Dim partI As Part
Dim prodI As Product
prodI = cRelevantProducts.Item(i)
Dim docName As String
@@ -133,18 +140,18 @@ Public Class AssemblyTiers2
'############################################################################
'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
+ '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)
'Base component is in cRelevantProducts, but not moveable
If productIsInCollection(prodI, cBaseProducts) Then
@@ -160,14 +167,21 @@ Public Class AssemblyTiers2
Dim BBSecondsElapsed As Double
BBSecondsElapsed = Math.Round(BBMillisecondsElapsed / 1000.0, 2)
MsgBox("Bounding box calculation took " & CStr(BBSecondsElapsed) & " seconds")
+ Debug.Print("Number of faces in assembly: " & CStr(intNumFaces))
- MsgBox("Assembly Boundaries: " & vbNewLine &
- "max_X = " & aAssemblyBoundaries(0) & vbNewLine &
- "min_X = " & aAssemblyBoundaries(1) & vbNewLine &
- "max_Y = " & aAssemblyBoundaries(2) & vbNewLine &
- "min_Y = " & aAssemblyBoundaries(3) & vbNewLine &
- "max_Z = " & aAssemblyBoundaries(4) & vbNewLine &
- "min_Z = " & aAssemblyBoundaries(5))
+ 'Collision parameters
+ Dim dGeomMean As Double
+ dGeomMean = (aAssemblyBoundaries(0) - aAssemblyBoundaries(1)) * (aAssemblyBoundaries(2) - aAssemblyBoundaries(3)) * (aAssemblyBoundaries(4) - aAssemblyBoundaries(5))
+ dGeomMean = dGeomMean ^ (1 / 3)
+ intStep = Math.Round(dGeomMean / 50, 0)
+ Debug.Print("Movement step: " & CStr(intStep))
+
+ dCollSens = 2
+
+ MsgBox("Assembly dimensions: " & vbNewLine &
+ "X = " & aAssemblyBoundaries(0) - aAssemblyBoundaries(1) & vbNewLine &
+ "Y = " & aAssemblyBoundaries(2) - aAssemblyBoundaries(3) & vbNewLine &
+ "Z = " & aAssemblyBoundaries(4) - aAssemblyBoundaries(5))
'After the aAssemblyBoundaries and aPartBBGlob are calculated, define aRemovalDistances
For i = 0 To cRelevantProducts.Count - 1
@@ -179,15 +193,16 @@ Public Class AssemblyTiers2
aRemovalDistances(i, 5) = aAssemblyBoundaries(5) - aPartBBGlob(i, 4)
Next i
- MsgBox("Removal distances for " & cRelevantProducts.Item(1).PartNumber & ":" & vbNewLine &
- "X_pos = " & aRemovalDistances(0, 0) & vbNewLine &
- "X_neg = " & aRemovalDistances(0, 1) & vbNewLine &
- "Y_pos = " & aRemovalDistances(0, 2) & vbNewLine &
- "Y_neg = " & aRemovalDistances(0, 3) & vbNewLine &
- "Z_pos = " & aRemovalDistances(0, 4) & vbNewLine &
- "Z_neg = " & aRemovalDistances(0, 5))
+ 'MsgBox("Removal distances for " & cRelevantProducts.Item(1).PartNumber & ":" & vbNewLine &
+ '"X_pos = " & aRemovalDistances(0, 0) & vbNewLine &
+ '"X_neg = " & aRemovalDistances(0, 1) & vbNewLine &
+ '"Y_pos = " & aRemovalDistances(0, 2) & vbNewLine &
+ '"Y_neg = " & aRemovalDistances(0, 3) & vbNewLine &
+ '"Z_pos = " & aRemovalDistances(0, 4) & vbNewLine &
+ '"Z_neg = " & aRemovalDistances(0, 5))
'#################### Main algorithm ##########################
+
Dim intI As Integer 'total number of components in the scene minus base parts
Dim intJ As Integer 'number of primary directions (default: global + local)
Dim intTier As Integer 'number of current assembly tier
@@ -238,25 +253,6 @@ Public Class AssemblyTiers2
Dim cGroups As Groups
cGroups = CATIA.ActiveDocument.Product.GetTechnologicalObject("Groups")
- 'calculate initial clashes (due to imprecise modelling or STEP file export...)
- ' Dim cInitClashes AsCollection
- ' Dim oInitClash 'As Clash
- ' ' oInitClash = cInitClashes.Add
- ' oInitClash.ComputationType = catClashComputationTypeBetweenAll
- ' oInitClash.Compute
- ' Dim cInitConflicts As Conflicts
- ' cInitConflicts = oInitClash.Conflicts
- ' Dim numConfl As Integer
- ' Dim numClashes As Integer
- ' numClashes = 0
- ' For numConfl = 1 To cInitConflicts.Count
- ' If cInitConflicts.Item(numConfl).Type = catConflictTypeClash Then
- ' cInitClashes.Add cInitConflicts.Item(numConfl)
- ' numClashes = numClashes + 1
- ' End If
- ' Next numConfl
- ' MsgBox CStr(numClashes) & " clashes were detected in the original model."
-
Dim StartTime As DateTime
StartTime = Now
@@ -286,14 +282,6 @@ Public Class AssemblyTiers2
bInitPosRecorded(int_i) = True
End If
- 'For each product, determine whether it is a base product, deactivated or virtual
- ' Dim bBaseProduct As Boolean
- ' bBaseProduct = productIsInCollection(product1, cBaseProducts)
- ' Dim bDeactivated As Boolean
- ' bDeactivated = productIsInCollection(product1, cDeactivated)
- ' Dim bVirtual As Boolean
- ' bVirtual = productIsInCollection(product1, cVirtual)
-
'Group that includes our product (needed for collision detection between two selections or groups)
Dim group1 As Group
group1 = cGroups.Add
@@ -305,7 +293,9 @@ Public Class AssemblyTiers2
Dim iStaticProduct As Integer
For iStaticProduct = 0 To cRelevantProducts.Count - 1
If iStaticProduct <> int_i And Not bDeactivated(iStaticProduct) Then
- group2.AddExplicit(cRelevantProducts.Item(iStaticProduct))
+ If BoundingBoxesOverlap(int_i, iStaticProduct) Then
+ group2.AddExplicit(cRelevantProducts.Item(iStaticProduct))
+ End If
End If
Next iStaticProduct
@@ -618,7 +608,6 @@ exitCD:
If disassDir(int_i, intAxis) = 1 Then
disassDir(int_i, intAxis) = 0
disassDir(int_i, d3.Item(intAxis)) = 1
- Exit For
End If
Next intAxis
Next int_i
@@ -835,7 +824,7 @@ exitCD:
CATIA.StartCommand("Activate / Deactivate Component")
selection1.Clear()
intFasteners = intFasteners + 1
- ElseIf InStr(sName, "screw") Or InStr(sName, "schraube") > 0 Then
+ 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)
@@ -862,16 +851,16 @@ exitCD:
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)
+ 'ElseIf InStr(sName, "pin") > 0 Then
+ ' Debug.Print(prod.Name + " was identified as a pin")
+ ' selection1.Add(prod)
- primaryFasteners.Add(prod)
+ ' primaryFasteners.Add(prod)
- CATIA.StartCommand("Activate / Deactivate Component")
- selection1.Clear()
- intFasteners = intFasteners + 1
- ElseIf InStr(sName, "nut") > 0 Then
+ ' 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)
@@ -880,7 +869,7 @@ exitCD:
CATIA.StartCommand("Activate / Deactivate Component")
selection1.Clear()
intFasteners = intFasteners + 1
- ElseIf InStr(sName, "washer") > 0 Then
+ 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)
@@ -1001,6 +990,7 @@ exitCD:
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
@@ -1714,4 +1704,15 @@ Finish:
Return intAns
End Function
+ 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
+
End Class
diff --git a/CatiaNetTest/CatiaNetTest.vbproj b/CatiaNetTest/CatiaNetTest.vbproj
index 01bf99af4e81a838ef374e743fd3d2a0804ff380..36b6adaf1f53f4d1a70483349b728cc2c2ac1b3c 100644
--- a/CatiaNetTest/CatiaNetTest.vbproj
+++ b/CatiaNetTest/CatiaNetTest.vbproj
@@ -81,6 +81,7 @@
<DependentUpon>Form1.vb</DependentUpon>
<SubType>Form</SubType>
</Compile>
+ <Compile Include="HierarchicalAssemblyTiers.vb" />
<Compile Include="My Project\AssemblyInfo.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
diff --git a/CatiaNetTest/Form1.Designer.vb b/CatiaNetTest/Form1.Designer.vb
index 4b13759686da8538c48bb90b335c925a823b0f8e..c8a93736a9aff1c5b2c76a2b9686ceb6a102e8f3 100644
--- a/CatiaNetTest/Form1.Designer.vb
+++ b/CatiaNetTest/Form1.Designer.vb
@@ -26,6 +26,10 @@ Partial Class Form1
Me.Button1 = New System.Windows.Forms.Button()
Me.Label2 = New System.Windows.Forms.Label()
Me.Button2 = New System.Windows.Forms.Button()
+ Me.Label3 = New System.Windows.Forms.Label()
+ Me.Button3 = New System.Windows.Forms.Button()
+ Me.Label4 = New System.Windows.Forms.Label()
+ Me.Button4 = New System.Windows.Forms.Button()
Me.SuspendLayout()
'
'Label1
@@ -49,26 +53,66 @@ Partial Class Form1
'Label2
'
Me.Label2.AutoSize = True
- Me.Label2.Location = New System.Drawing.Point(92, 96)
+ Me.Label2.Location = New System.Drawing.Point(92, 86)
Me.Label2.Name = "Label2"
- Me.Label2.Size = New System.Drawing.Size(109, 13)
+ Me.Label2.Size = New System.Drawing.Size(118, 13)
Me.Label2.TabIndex = 2
- Me.Label2.Text = "Start collision analysis"
+ Me.Label2.Text = "Simple collision analysis"
'
'Button2
'
- Me.Button2.Location = New System.Drawing.Point(249, 96)
+ Me.Button2.Location = New System.Drawing.Point(249, 81)
Me.Button2.Name = "Button2"
Me.Button2.Size = New System.Drawing.Size(114, 23)
Me.Button2.TabIndex = 3
- Me.Button2.Text = "Assembly Tiers 2"
+ Me.Button2.Text = "Assembly Tiers"
Me.Button2.UseVisualStyleBackColor = True
'
+ 'Label3
+ '
+ Me.Label3.AutoSize = True
+ Me.Label3.Location = New System.Drawing.Point(92, 123)
+ Me.Label3.Name = "Label3"
+ Me.Label3.Size = New System.Drawing.Size(91, 13)
+ Me.Label3.TabIndex = 4
+ Me.Label3.Text = "Complex products"
+ '
+ 'Button3
+ '
+ Me.Button3.Location = New System.Drawing.Point(249, 118)
+ Me.Button3.Name = "Button3"
+ Me.Button3.Size = New System.Drawing.Size(114, 23)
+ Me.Button3.TabIndex = 5
+ Me.Button3.Text = "Hierarchical"
+ Me.Button3.UseVisualStyleBackColor = True
+ '
+ 'Label4
+ '
+ Me.Label4.AutoSize = True
+ Me.Label4.Location = New System.Drawing.Point(92, 160)
+ Me.Label4.Name = "Label4"
+ Me.Label4.Size = New System.Drawing.Size(144, 13)
+ Me.Label4.TabIndex = 6
+ Me.Label4.Text = "AND/OR graph requirements"
+ '
+ 'Button4
+ '
+ Me.Button4.Location = New System.Drawing.Point(249, 155)
+ Me.Button4.Name = "Button4"
+ Me.Button4.Size = New System.Drawing.Size(114, 23)
+ Me.Button4.TabIndex = 7
+ Me.Button4.Text = "LG + MW"
+ Me.Button4.UseVisualStyleBackColor = True
+ '
'Form1
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
- Me.ClientSize = New System.Drawing.Size(468, 191)
+ Me.ClientSize = New System.Drawing.Size(468, 217)
+ Me.Controls.Add(Me.Button4)
+ Me.Controls.Add(Me.Label4)
+ Me.Controls.Add(Me.Button3)
+ Me.Controls.Add(Me.Label3)
Me.Controls.Add(Me.Button2)
Me.Controls.Add(Me.Label2)
Me.Controls.Add(Me.Button1)
@@ -84,4 +128,8 @@ Partial Class Form1
Friend WithEvents Button1 As Button
Friend WithEvents Label2 As Label
Friend WithEvents Button2 As Button
+ Friend WithEvents Label3 As Label
+ Friend WithEvents Button3 As Button
+ Friend WithEvents Label4 As Label
+ Friend WithEvents Button4 As Button
End Class
diff --git a/CatiaNetTest/Form1.vb b/CatiaNetTest/Form1.vb
index ac24fb4678e3c0a4e8390a2f371aebf0d2599475..905540142b24b0c93471bb172395ea9b37253cc1 100644
--- a/CatiaNetTest/Form1.vb
+++ b/CatiaNetTest/Form1.vb
@@ -39,4 +39,19 @@ Public Class Form1
End Try
End Sub
+
+ Private Sub Label3_Click(sender As Object, e As EventArgs) Handles Label3.Click
+
+ End Sub
+
+ Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
+
+ Dim hierarchicalAlgorithm As HierarchicalAssemblyTiers = New HierarchicalAssemblyTiers()
+
+ Try
+ hierarchicalAlgorithm.CatMain()
+ Catch ex As Exception
+
+ End Try
+ End Sub
End Class
diff --git a/CatiaNetTest/HierarchicalAssemblyTiers.vb b/CatiaNetTest/HierarchicalAssemblyTiers.vb
new file mode 100644
index 0000000000000000000000000000000000000000..a6dab04571715d2babb81a514eb056f3b946cb5e
--- /dev/null
+++ b/CatiaNetTest/HierarchicalAssemblyTiers.vb
@@ -0,0 +1,1825 @@
+Imports System
+Imports HybridShapeTypeLib
+Imports INFITF
+Imports MECMOD
+Imports NavigatorTypeLib
+Imports ProductStructureTypeLib
+Imports SPATypeLib
+Imports PARTITF
+Imports Microsoft.Office.Interop.Excel
+
+Public Class HierarchicalAssemblyTiers
+
+ Public intStep As Integer
+ Public dCollSens As Double
+ Public intParts As Integer
+ Public intNumFaces As Integer
+ Public primaryFasteners As New ArrayList
+ Public secondaryFasteners As New ArrayList
+ Public cAllProducts As New ArrayList
+ Public cRelevantProducts As New ArrayList
+ Public cBaseProducts As New ArrayList
+ Public aRemovalDistances(,) As Double
+ Public aAssemblyBoundaries(5) As Double
+ Public aPartBBGlob(,) As Double
+ Public aInitPos(,) As Double
+ Public sChosenDirection As String
+ Public oList As Object
+ 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
+
+ AssemblyTiersDetermination(topProduct)
+
+ End Sub
+
+ Sub AssemblyTiersDetermination(theProduct As Product)
+
+ cAllProducts = New ArrayList
+ cRelevantProducts = New ArrayList
+ cBaseProducts = New ArrayList
+
+ Debug.Print("========================================================")
+
+ 'Get Products that are one level deeper in the specification tree only (direct children)
+ Dim oInstances As Collection
+ oInstances = theProduct.Products
+ Dim i As Integer
+ Dim outputText As String
+
+ intParts = oInstances.Count
+ outputText = "This assembly contains " + CStr(intParts) + " components" + vbNewLine
+ MsgBox(outputText)
+
+ 'Select the assembly's base components
+ 'Declare selection
+ Dim oSel As Selection
+ Dim baseSel As Object 'to deal with restricted function problem
+ oSel = CATIA.ActiveDocument.Selection
+ baseSel = oSel
+ 'Create an array for CATProducts
+ Dim strArray(0)
+ strArray(0) = "Product"
+ 'Display a messagebox prompting the user to select CATIA parts
+ MsgBox("Please select the assembly's base product")
+ Dim sStatus As String
+ sStatus = baseSel.SelectElement3(strArray, "Select parts or subassemblies", False, INFITF.CATMultiSelectionMode.CATMultiSelTriggWhenUserValidatesSelection, False)
+
+ For i = 1 To baseSel.Count
+ cBaseProducts.Add(baseSel.Item(i).LeafProduct)
+ Debug.Print("Added base component: " & baseSel.Item(i).LeafProduct.Name)
+ Next
+
+ oSel.Clear()
+ baseSel.Clear
+
+ 'Separation of components
+ DeactivateFasteners(theProduct)
+
+ 'Display the number of relevant parts
+ outputText = CStr(cRelevantProducts.Count) + " components are considered in precedence graph generation"
+ MsgBox(outputText)
+
+ 'Distances from global axis system origin to assembly boundary (along global axis)
+ aAssemblyBoundaries(0) = 0# 'max_X
+ aAssemblyBoundaries(1) = 0# 'min_X
+ aAssemblyBoundaries(2) = 0# 'max_Y
+ aAssemblyBoundaries(3) = 0# 'min_Y
+ aAssemblyBoundaries(4) = 0# 'max_Z
+ aAssemblyBoundaries(5) = 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
+
+ Dim BBStartTime As DateTime
+ BBStartTime = Now
+
+ 'This is used to check whether a product must be moved in current iteration
+ Dim bMoveable(cRelevantProducts.Count - 1) As Boolean
+
+ 'Number of faces in assembly represents the geometrical complexity of parts
+ intNumFaces = 0
+
+ For i = 0 To cRelevantProducts.Count - 1
+
+ 'Get collection of elementary parts (elements, leaf parts) making up subassembly i
+ Dim oSubassembly As Product
+ oSubassembly = cRelevantProducts.Item(i)
+ Dim cElements As New ArrayList
+ ExtractProducts(oSubassembly, cElements)
+
+ Debug.Print("Elementary parts: " & CStr(cElements.Count))
+
+ For j = 0 To cElements.Count - 1
+
+ '########## this won't work if part document name is not = part number ######
+ ''Dim partI As Part
+ Dim prodI As Product
+ prodI = cElements.Item(j)
+ 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 = cElements.Item(j)
+ '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 j
+
+ 'Base component is in cRelevantProducts, but not moveable
+ If productIsInCollection(oSubassembly, cBaseProducts) Then
+ bMoveable(i) = False
+ Else
+ bMoveable(i) = True
+ End If
+
+ Next i
+
+ Dim BBMillisecondsElapsed As Double
+ BBMillisecondsElapsed = (Now - BBStartTime).TotalMilliseconds
+ Dim BBSecondsElapsed As Double
+ BBSecondsElapsed = Math.Round(BBMillisecondsElapsed / 1000.0, 2)
+ MsgBox("Bounding box calculation took " & CStr(BBSecondsElapsed) & " seconds")
+ Debug.Print("Number of faces in assembly: " & CStr(intNumFaces))
+
+ 'Collision parameters
+ Dim dGeomMean As Double
+ dGeomMean = (aAssemblyBoundaries(0) - aAssemblyBoundaries(1)) * (aAssemblyBoundaries(2) - aAssemblyBoundaries(3)) * (aAssemblyBoundaries(4) - aAssemblyBoundaries(5))
+ dGeomMean = dGeomMean ^ (1 / 3)
+ intStep = Math.Round(dGeomMean / 50, 0)
+ Debug.Print("Movement step: " & CStr(intStep))
+
+ dCollSens = 2
+
+ MsgBox("Assembly dimensions: " & vbNewLine &
+ "X = " & aAssemblyBoundaries(0) - aAssemblyBoundaries(1) & vbNewLine &
+ "Y = " & aAssemblyBoundaries(2) - aAssemblyBoundaries(3) & vbNewLine &
+ "Z = " & aAssemblyBoundaries(4) - aAssemblyBoundaries(5))
+
+ '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
+
+ 'MsgBox("Removal distances for " & cRelevantProducts.Item(1).PartNumber & ":" & vbNewLine &
+ '"X_pos = " & aRemovalDistances(0, 0) & vbNewLine &
+ '"X_neg = " & aRemovalDistances(0, 1) & vbNewLine &
+ '"Y_pos = " & aRemovalDistances(0, 2) & vbNewLine &
+ '"Y_neg = " & aRemovalDistances(0, 3) & vbNewLine &
+ '"Z_pos = " & aRemovalDistances(0, 4) & vbNewLine &
+ '"Z_neg = " & aRemovalDistances(0, 5))
+
+ '#################### Main algorithm ##########################
+
+ Dim intI As Integer 'total number of components in the scene minus base parts
+ Dim intJ As Integer 'number of primary directions (default: global + local)
+ Dim intTier As Integer 'number of current assembly tier
+ Dim int_i As Integer 'product index in cRelevantProducts
+ Dim int_i_cycle As Integer 'product counter
+ Dim int_j As Integer 'primary direction index 1..12
+ Dim int_j_temp As Integer 'used to display movement direction once
+ Dim int_k As Integer 'secondary direction index 1..10
+ Dim total_coll As Long 'counter of total collision detections
+ Dim cDeactivated As New ArrayList 'really deactivated products
+ Dim cVirtual As Collection 'these funny green parts
+ Dim precedenceMatrix(cRelevantProducts.Count - 1, cRelevantProducts.Count - 1) As Single
+ Dim disassDir(cRelevantProducts.Count - 1, 11)
+ Dim aTiers(cRelevantProducts.Count - 1) As Integer
+ ReDim aInitPos(cRelevantProducts.Count - 1, 11) 'remember initial positions of the products
+ Dim bInitPosRecorded(cRelevantProducts.Count - 1) As Boolean
+ Dim bDeactivated(cRelevantProducts.Count - 1) As Boolean
+
+ intI = cRelevantProducts.Count - 1 'the index of base components will be simply skipped (cRelevantProducts includes cBaseProducts, unlike in the paper!)
+ intJ = 6 'number of disassembly directions (6 - only global axes, 12 - including local axes)
+ intTier = 1 'counts current disassembly tier (lower number means earlier disassembly possible) - this gets reversed in the end
+ int_i = 0 'index of current part in collection of relevant products
+ int_i_cycle = 0 'counter for the current tier iteration
+ int_j = 0 'index of disassembly direction
+ int_j_temp = 0 'used to display movement direction once
+ total_coll = 0
+
+ 'map indices to directions (careful, starts from 0 here, but the paper and moveProduct uses 1 as start)
+ Dim d1
+ d1 = CreateObject("Scripting.Dictionary")
+ d1.Add(0, "Global X+")
+ d1.Add(1, "Global Y+")
+ d1.Add(2, "Global Z+")
+ d1.Add(3, "Global X-")
+ d1.Add(4, "Global Y-")
+ d1.Add(5, "Global Z-")
+ d1.Add(6, "Local X+")
+ d1.Add(7, "Local Y+")
+ d1.Add(8, "Local Z+")
+ d1.Add(9, "Local X-")
+ d1.Add(10, "Local Y-")
+ d1.Add(11, "Local Z-")
+
+ '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")
+
+ Dim StartTime As DateTime
+ StartTime = Now
+
+ Do
+
+ 'Processing next Product
+ Dim product1 As Product
+ product1 = cRelevantProducts.Item(int_i)
+ Debug.Print("Processing " & product1.Name & " [tier=" & intTier & ", i_cycle=" & int_i_cycle & ", I=" & intI & "]")
+
+ 'Skip not moveable products
+ If Not bMoveable(int_i) Then
+ 'the part is a base component or deactivated
+ GoTo entry0
+ End If
+
+ 'Remember initial position P_i (initPos)
+ Dim initPos(11)
+ Dim oPosition1 As Object
+ oPosition1 = product1.Position
+ oPosition1.GetComponents(initPos)
+ If bInitPosRecorded(int_i) = False Then
+ Dim ip As Integer
+ For ip = 0 To 11
+ aInitPos(int_i, ip) = initPos(ip)
+ Next ip
+ bInitPosRecorded(int_i) = True
+ End If
+
+ 'Group that includes our product (needed for collision detection between two selections or groups)
+ Dim group1 As Group
+ group1 = cGroups.Add
+ group1.AddExplicit(product1)
+
+ 'Create a Group of Products that this product shouldn't collide with
+ Dim group2 As Group
+ group2 = cGroups.Add
+ Dim iStaticProduct As Integer
+ For iStaticProduct = 0 To cRelevantProducts.Count - 1
+ If iStaticProduct <> int_i And Not bDeactivated(iStaticProduct) Then
+ group2.AddExplicit(cRelevantProducts.Item(iStaticProduct))
+ End If
+ Next iStaticProduct
+
+ Do
+entry1:
+ 'Movement step in a given direction
+
+ 'If it is a movable part (not base component or already deactivated or "virtual" part from higher tier)...
+ If bMoveable(int_i) = True Then
+
+ 'move component intStep distance in int_j direction
+ moveProduct(product1, int_j, True)
+
+ 'display current disassembly direction once it changes
+ If int_j <> int_j_temp Then
+ Debug.Print("[" & d1.Item(int_j) & "]")
+ int_j_temp = int_j
+ End If
+
+ 'collision detection
+ If collisionDetected(cClashes, group1, group2) Then
+
+ 'check for collisions with higher tier
+ Dim detConflicts As Conflicts
+ detConflicts = cClashes.Item(cClashes.Count).Conflicts
+
+ If detConflicts.Count > 0 Then
+
+ Dim oConflict1 As Conflict
+ Dim ic As Integer
+
+ For ic = 1 To detConflicts.Count
+
+ oConflict1 = detConflicts.Item(ic)
+ oConflict1.Status = SPATypeLib.CatConflictStatus.catConflictStatusRelevant
+
+ If oConflict1.Type = SPATypeLib.CatConflictType.catConflictTypeClash Then
+
+ If oConflict1.Value < -dCollSens Then
+
+ Dim secProduct As Product
+ 'get the product we collided with
+ secProduct = oConflict1.SecondProduct
+
+ 'find the tier of the second product
+ 'Dim dummyProd As Product
+ 'Dim iIndex As Integer
+ 'iIndex = 0
+ 'For Each dummyProd In cRelevantProducts
+ ' If dummyProd.Name = secProduct.Name Then
+ ' Exit For
+ ' End If
+ ' iIndex = iIndex + 1
+ 'Next dummyProd
+ Dim secTier As Integer
+ Dim iIndex As Integer
+ iIndex = ParentSubassemblyIndex(secProduct, cRelevantProducts)
+ secTier = aTiers(iIndex)
+
+ 'as soon as secTier is not the direct higher tier, no reason to move further
+ If secTier < intTier - 1 Then
+ GoTo exit1
+ End If
+
+ 'if the disassembly tier is 1 lower (attention: tiers get reversed in the end to the assembly tiers!)
+ If secTier = intTier - 1 And Not (secTier = 0 And intTier = 1) Then
+
+ Debug.Print("Collision with higher tier: " & oConflict1.FirstProduct.Name & " - " & oConflict1.SecondProduct.Name & " = " & oConflict1.Value)
+
+ 'record precedence relation, because secProduct is an obstacle in the way of the current product
+ precedenceMatrix(int_i, iIndex) = 1
+
+ 'move the product through the "virtual" part from higher tier
+ GoTo entry1
+
+ End If
+
+ End If 'deeper than dCollSens
+
+ End If 'clash
+
+ Next ic 'next conflict
+
+ End If
+exit1:
+ 'move product to initial position
+ Dim oPosition3 As Object
+ oPosition3 = product1.Position
+ oPosition3.SetComponents(initPos)
+ 'take next direction
+ int_j = int_j + 1
+ 'if not all directions are checked for this product...
+ If int_j < intJ Then
+ 'continue movement in primary directions (movement loop)
+ Else
+ 'all directions were checked
+ total_coll = total_coll + intJ
+ Debug.Print("Disassembly trials: " & total_coll)
+ int_i = int_i + 1
+ int_i_cycle = int_i_cycle + 1
+ int_j = 0
+ int_j_temp = 0
+
+ 'if active products remain in this cycle...
+ If int_i_cycle <= intI - cBaseProducts.Count Then
+ 'process next product in this cycle
+ Exit Do
+ Else
+ 'all components in this cycle were checked
+ Dim p As Integer
+ Dim intItemp As Integer
+ intItemp = intI
+ 'record tiers
+ For p = 0 To cRelevantProducts.Count - 1
+ If productIsInCollection(cRelevantProducts.Item(p), cBaseProducts) Then
+ 'base product always has tier 0 (doesn't get reversed)
+ aTiers(p) = 0
+ Else
+ 'not a base product
+ 'product has valid disass. directions and has no tier recorded yet
+ If productHasValidDisassDir(p, disassDir) And Not aTiers(p) > 0 Then
+ 'save tier
+ aTiers(p) = intTier
+ 'decrease the counter of active products in assembly
+ intI = intI - 1
+ 'change visuals for "virtual" products
+ Dim virtSelection As Selection
+ virtSelection = CATIA.ActiveDocument.Selection
+ virtSelection.Clear()
+ virtSelection.Add(cRelevantProducts.Item(p))
+ Dim visProperties1 As Object
+ visProperties1 = virtSelection.VisProperties
+ visProperties1.SetRealColor(80, 255, 160, 1)
+ virtSelection.Clear()
+ 'remember virtual green products
+ 'cVirtual.Add cRelevantProducts.Item(p)
+ 'fix position
+ bMoveable(p) = False
+ 'Deactivate last disassembly tier directly
+ If intI = cBaseProducts.Count - 1 Then
+ Dim selektion As Selection
+ selektion = CATIA.ActiveDocument.Selection
+ selektion.Clear()
+ selektion.Add(cRelevantProducts.Item(p))
+ CATIA.StartCommand("Activate / Deactivate Component")
+ selektion.Clear()
+ cDeactivated.Add(cRelevantProducts.Item(p))
+ bDeactivated(p) = True
+ End If
+ End If
+ 'product from higher tier
+ If productHasValidDisassDir(p, disassDir) And aTiers(p) = intTier - 1 Then
+ 'deactivate
+ Dim selection2 As Selection
+ selection2 = CATIA.ActiveDocument.Selection
+ selection2.Clear()
+ selection2.Add(cRelevantProducts.Item(p))
+ CATIA.StartCommand("Activate / Deactivate Component")
+ selection2.Clear()
+ cDeactivated.Add(cRelevantProducts.Item(p))
+ bDeactivated(p) = True
+ End If
+ End If
+ Next p
+
+ 'Notify the user if no parts could be disassembled in this tier
+ If intI = intItemp Then
+ Debug.Print("WARNING! No parts could be removed during this cycle." & vbNewLine & "This is usually due to inaccuracies in modelling (e.g. collisions in initial assembly).")
+ GoTo exitCD
+ End If
+
+ 'recalculate assembly boundaries and removal distances
+ RecalculateRemovalDistances(cRelevantProducts, cDeactivated)
+
+ 'if there are still parts to disassemble...
+ If intI >= cBaseProducts.Count Then
+ 'increment tier
+ intTier = intTier + 1
+ 'process next cycle of products
+ int_i = 0
+ int_i_cycle = 0
+ Exit Do
+ Else
+ 'all parts were disassembled
+ 'end collision detection algorithm
+ GoTo exitCD
+ End If
+ End If
+ End If
+ Else
+ 'no collisions after the movement step
+ 'check whether part reached final position
+ If productReachedFinalPosition(product1, int_i) Then
+ 'store valid disassembly direction
+ disassDir(int_i, int_j) = 1
+ GoTo exit1
+ Else
+ 'continue movement in primary directions (movement loop)
+ End If
+ End If
+ Else
+entry0:
+ 'the part is a base component or deactivated
+ Debug.Print("Skipping " + product1.Name + " (base component or deactivated)")
+ int_i = int_i + 1
+ 'process next product
+ Exit Do
+ End If
+ Loop 'movement loop
+ Loop 'product loop
+
+exitCD:
+
+ Dim SecondsElapsed As Double
+ Dim MillisecondsElapsed As Double
+ MillisecondsElapsed = (Now - StartTime).TotalMilliseconds
+ SecondsElapsed = Math.Round(MillisecondsElapsed / 1000.0, 2)
+ MsgBox("Collision detection algorithm finished execution after " & CStr(SecondsElapsed) & " seconds")
+
+ 'Return products to their initial positions, activate them
+ Dim p1 As Integer
+ For p1 = 0 To cRelevantProducts.Count - 1
+ If Not productIsInCollection(cRelevantProducts.Item(p1), cBaseProducts) And bDeactivated(p1) Then
+ Dim oPosition4 As Object
+ oPosition4 = cRelevantProducts.Item(p1).Position
+ Dim aPos(11)
+ For comp = 0 To 11
+ aPos(comp) = aInitPos(p1, comp)
+ Next comp
+ oPosition4.SetComponents(aPos)
+ Dim selection4 As Selection
+ selection4 = CATIA.ActiveDocument.Selection
+ selection4.Clear()
+ selection4.Add(cRelevantProducts.Item(p1))
+ CATIA.StartCommand("Activate / Deactivate Component")
+ selection4.Clear()
+ End If
+ Next p1
+
+ 'Select a single extraction direction in case there are multiple
+ Dim d2
+ d2 = CreateObject("Scripting.Dictionary")
+ d2.Add("Global X+", 0)
+ d2.Add("Global Y+", 1)
+ d2.Add("Global Z+", 2)
+ d2.Add("Global X-", 3)
+ d2.Add("Global Y-", 4)
+ d2.Add("Global Z-", 5)
+ d2.Add("Local X+", 6)
+ d2.Add("Local Y+", 7)
+ d2.Add("Local Z+", 8)
+ d2.Add("Local X-", 9)
+ d2.Add("Local Y-", 10)
+ d2.Add("Local Z-", 11)
+ 'Inverse axis indices
+ Dim d3
+ d3 = CreateObject("Scripting.Dictionary")
+ d3.Add(0, 3)
+ d3.Add(1, 4)
+ d3.Add(2, 5)
+ d3.Add(3, 0)
+ d3.Add(4, 1)
+ d3.Add(5, 2)
+ d3.Add(6, 9)
+ d3.Add(7, 10)
+ d3.Add(8, 11)
+ d3.Add(9, 6)
+ d3.Add(10, 7)
+ d3.Add(11, 8)
+ For int_i = 0 To cRelevantProducts.Count - 1
+ 'Dim sum As Integer
+ 'sum = 0
+ 'For intAxis = 0 To intJ - 1
+ ' sum = sum + disassDir(int_i, intAxis)
+ 'Next intAxis
+ ''Only for products with multiple extraction directions
+ 'If sum > 1 Then
+ ' 'Add options to ComboBox
+ ' For intAxis = 0 To intJ - 1
+ ' If disassDir(int_i, intAxis) = 1 Then
+ ' ExtractionDirection.ComboBox1.AddItem(d1.Item(intAxis))
+ ' End If
+ ' Next intAxis
+ ' 'Highlight the product in CATIA
+ ' Dim selection5 As Selection
+ ' selection5 = CATIA.ActiveDocument.Selection
+ ' selection5.Clear()
+ ' selection5.Add(cRelevantProducts.Item(int_i + 1))
+ ' 'Show dialog
+ ' ExtractionDirection.Show
+ ' selection5.Clear()
+ ' 'Translate chosen axis name back into index 0..11
+ ' Dim iChosenDir As Integer
+ ' iChosenDir = d2.Item(sChosenDirection)
+ ' 'Set all other disassembly directions to 0
+ ' For intAxis = 0 To intJ - 1
+ ' If intAxis = iChosenDir Then
+ ' disassDir(int_i, intAxis) = 1
+ ' Else
+ ' disassDir(int_i, intAxis) = 0
+ ' End If
+ ' Next intAxis
+ 'End If
+ 'Reverse tier values
+ Dim intMaxTier As Integer
+ intMaxTier = intTier
+ If aTiers(int_i) <> 0 Then
+ aTiers(int_i) = intMaxTier + 1 - aTiers(int_i)
+ End If
+ 'Reverse disassembly axis (assembly axis = -disass. axis)
+ For intAxis = 0 To intJ - 1
+ If disassDir(int_i, intAxis) = 1 Then
+ disassDir(int_i, intAxis) = 0
+ disassDir(int_i, d3.Item(intAxis)) = 1
+ End If
+ Next intAxis
+ Next int_i
+
+ 'Association of components belonging to sequential tiers
+
+ Dim cClashes1 As Clashes
+ Dim oClash1 As Clash
+ oClash1 = cClashes.Add
+ oClash1.ComputationType = CatClashComputationType.catClashComputationTypeBetweenAll
+ oClash1.Compute
+ Dim cInitConflicts As Conflicts
+ cInitConflicts = oClash1.Conflicts
+ Dim initConfl As Conflict
+ Dim nConfl As Integer
+ nConfl = 0
+ For Each initConfl In cInitConflicts
+ Dim firstIndex As Integer
+ Dim secondIndex As Integer
+ firstIndex = ParentSubassemblyIndex(initConfl.FirstProduct, cRelevantProducts)
+ secondIndex = ParentSubassemblyIndex(initConfl.SecondProduct, cRelevantProducts)
+ If aTiers(firstIndex) = aTiers(secondIndex) - 1 Then
+ precedenceMatrix(firstIndex, secondIndex) = 1
+ End If
+ If aTiers(secondIndex) = aTiers(firstIndex) - 1 Then
+ precedenceMatrix(secondIndex, firstIndex) = 1
+ End If
+ Next initConfl
+
+ ' For int_i = 1 To cRelevantProducts.Count
+ ' Dim bNoContacts As Boolean
+ ' bNoContacts = True
+ ' 'loop over components from previous tier
+ ' For int_j = 1 To cRelevantProducts.Count
+ ' If aTiers(int_j - 1) = aTiers(int_i - 1) - 1 And aTiers(int_i - 1) <> 0 Then
+ ' 'Test for contact
+ ' 'define two groups
+ ' Dim group11 As Group
+ ' Dim group21 As Group
+ ' group11 = cGroups.Add
+ ' group21 = cGroups.Add
+ ' group11.AddExplicit cRelevantProducts.Item(int_i)
+ ' group21.AddExplicit cRelevantProducts.Item(int_j)
+ ' 'create a new clash analysis
+ ' Dim oClash 'As Clash
+ ' oClash = cClashes.Add
+ ' oClash.ComputationType = catClashComputationTypeBetweenTwo
+ ' oClash.FirstGroup = group11
+ ' oClash.SecondGroup = group21
+ ' oClash.InterferenceType = catClashInterferenceTypeContact
+ ' oClash.Compute
+ ' Dim cConflicts As Conflicts
+ ' cConflicts = oClash.Conflicts
+ ' If cConflicts.Count > 0 Then
+ ' precedenceMatrix(int_j - 1, int_i - 1) = 1
+ ' bNoContacts = False
+ ' End If
+ ' End If
+ ' Next int_j
+ ' Next int_i
+
+ 'Export data to Excel
+ Dim objExcel As Microsoft.Office.Interop.Excel.Application
+ objExcel = CreateObject("Excel.Application")
+ objExcel.Visible = True
+ objExcel.Workbooks.Add
+ objExcel.ActiveWorkbook.Sheets.Add.Name = "Precedence Matrix"
+ Dim objSheet1, objSheet2 As Object
+ objSheet1 = objExcel.ActiveWorkbook.Worksheets(2)
+ objSheet1.Name = "Assembly Directions"
+ objSheet2 = objExcel.ActiveWorkbook.Worksheets(1)
+
+ 'Assembly directions
+ objSheet1.Cells(1, 1).Value = "Product"
+ objSheet1.Cells(1, 2).Value = "+X"
+ objSheet1.Cells(1, 3).Value = "+Y"
+ objSheet1.Cells(1, 4).Value = "+Z"
+ objSheet1.Cells(1, 5).Value = "-X"
+ objSheet1.Cells(1, 6).Value = "-Y"
+ objSheet1.Cells(1, 7).Value = "-Z"
+ objSheet1.Cells(1, 8).Value = "Assembly Tier"
+ For int_i = 0 To cRelevantProducts.Count - 1
+ objSheet1.Cells(int_i + 2, 1).Value = cRelevantProducts.Item(int_i).Name
+ For intAxis = 0 To intJ - 1
+ objSheet1.Cells(int_i + 2, 2 + intAxis).Value = disassDir(int_i, intAxis)
+ Next intAxis
+ objSheet1.Cells(int_i + 2, intJ + 2).Value = aTiers(int_i)
+ Next int_i
+
+ 'Precedence relations
+ For int_i = 0 To cRelevantProducts.Count - 1
+ For int_j = 0 To cRelevantProducts.Count - 1
+ objSheet2.Cells(int_i + 1, int_j + 1).Value = precedenceMatrix(int_i, int_j)
+ Next int_j
+ Next int_i
+
+ 'Save and close excel workbook
+ Dim xlsFileName As String = theProduct.PartNumber
+ Dim xlsPath As String = "D:\mikep\Files\RWTH\Master Produktionstechnik\Masterarbeit\Experimente\"
+ objExcel.ActiveWorkbook.SaveAs(Filename:=xlsPath & xlsFileName & ".xlsx")
+ objExcel.ActiveWorkbook.Close(SaveChanges:=True)
+ 'close the excel application
+ objExcel.Quit()
+ ReleaseObject(objExcel)
+
+ 'Once we are done on this level, generate precedence diagrams for each subassembly recursively
+ Dim subassembly As Product
+ For Each subassembly In cRelevantProducts
+ Dim leafProducts As New ArrayList
+ ExtractProducts(subassembly, leafProducts)
+ If leafProducts.Count > 5 Then
+ AssemblyTiersDetermination(subassembly)
+ End If
+ Next subassembly
+
+ End Sub
+ 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
+
+ Sub GetNextNode(oCurrentProduct As Product)
+
+ Dim oCurrentTreeNode As Product
+ Dim i As Integer
+
+ For i = 1 To oCurrentProduct.Products.Count
+ oCurrentTreeNode = oCurrentProduct.Products.Item(i)
+
+ If IsPart(oCurrentTreeNode) = True Then
+ MsgBox(oCurrentTreeNode.PartNumber & " is a part")
+ ElseIf IsProduct(oCurrentTreeNode) = True Then
+ MsgBox(oCurrentTreeNode.PartNumber & " is a product")
+ Else
+ MsgBox(oCurrentTreeNode.PartNumber & " is a component")
+ End If
+
+ 'recursive
+ If oCurrentTreeNode.Products.Count > 0 Then
+ GetNextNode(oCurrentTreeNode)
+ End If
+
+ Next
+
+ End Sub
+
+ Function IsPart(objCurrentProduct As Product) As Boolean
+
+ Dim oTestPart As PartDocument
+
+ oTestPart = Nothing
+
+ On Error Resume Next
+
+ oTestPart = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATPart")
+
+ If Not oTestPart Is Nothing Then
+ IsPart = True
+ Else
+ IsPart = False
+ End If
+
+ End Function
+
+ Function IsProduct(objCurrentProduct As Product) As Boolean
+
+ Dim oTestProduct As ProductDocument
+
+ oTestProduct = Nothing
+
+ On Error Resume Next
+
+ oTestProduct = CATIA.Documents.Item(objCurrentProduct.PartNumber & ".CATProduct")
+
+ If Not oTestProduct Is Nothing Then
+ IsProduct = True
+ Else
+ IsProduct = False
+ End If
+
+ End Function
+
+ Function DeactivateFasteners(objProduct As Product)
+
+ Dim objParts As 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
+
+ 'CATIA.StartCommand ("Activate / Deactivate Component")
+ Debug.Print("Deactivated " + CStr(intFasteners) + " fasteners")
+ intParts = intParts - intFasteners
+ Debug.Print(CStr(intParts) + " parts to assemble")
+ MsgBox("Fasteners are deacivated. Press OK to proceed.")
+
+ End Function
+
+ 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
+
+ 'If the part already contains a "Bounding Box", skip extremum point extraction
+ Dim partHasBB As Boolean = False
+ For Each body In part1.Bodies
+ If InStr(body.Name, "Bounding Box.") > 0 Then
+ partHasBB = True
+ Exit For
+ End If
+ Next
+
+ 'create references for Points and read coordinates from the references
+ Dim point_ref11, point_ref12, point_ref13, point_ref14, point_ref5, point_ref6 As Reference
+ Dim Point1, Point2, Point3, Point4, Point5, Point6 As HybridShapePointCoord
+
+ If partHasBB Then
+
+ For Each body In part1.Bodies
+ If InStr(body.Name, "Bounding Box.") > 0 Then
+ Dim hbDefPoints As HybridBody
+ hbDefPoints = body.HybridBodies.Item("definition_points")
+ Point1 = hbDefPoints.HybridShapes.Item(7)
+ point_ref11 = part1.CreateReferenceFromObject(Point1)
+ Point2 = hbDefPoints.HybridShapes.Item(8)
+ point_ref12 = part1.CreateReferenceFromObject(Point2)
+ Point3 = hbDefPoints.HybridShapes.Item(9)
+ point_ref13 = part1.CreateReferenceFromObject(Point3)
+ Point4 = hbDefPoints.HybridShapes.Item(10)
+ point_ref14 = part1.CreateReferenceFromObject(Point4)
+ Point5 = hbDefPoints.HybridShapes.Item(11)
+ point_ref5 = part1.CreateReferenceFromObject(Point5)
+ Point6 = hbDefPoints.HybridShapes.Item(12)
+ point_ref6 = part1.CreateReferenceFromObject(Point6)
+ Exit For
+ End If
+ Next
+
+ Else
+ 'Bounding Box hasn't been calculated for this part yet
+
+ '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
+
+ reference1 = faceSel.Item(1).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
+
+ End If 'partHasBB
+
+ 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:")
+
+ '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 & " (max_X): [" & 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 & " (min_X): [" & 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 & " (max_Y): [" & 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 & " (min_Y): [" & 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 & " (max_Z): [" & 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 & " (min_Z): [" & 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
+
+ Else
+ MsgBox("The active document must be a CATPart")
+ End If
+
+ End Function
+
+ Sub RecalculateRemovalDistances(cRelProd As ArrayList, cDeact As ArrayList)
+
+ Dim aRemovalDistances(cRelProd.Count - 1, 5)
+ Dim i As Integer
+ Dim relProd As Product
+ 'assure that the origin is inside the BB of assembly
+ aAssemblyBoundaries(0) = 0#
+ aAssemblyBoundaries(1) = 0#
+ aAssemblyBoundaries(2) = 0#
+ aAssemblyBoundaries(3) = 0#
+ aAssemblyBoundaries(4) = 0#
+ aAssemblyBoundaries(5) = 0#
+
+ For i = 0 To cRelProd.Count - 1
+ relProd = cRelProd.Item(i)
+ If Not productIsInCollection(relProd, cDeact) Then
+ If aInitPos(i, 9) + aPartBBGlob(i, 0) > aAssemblyBoundaries(0) Then
+ aAssemblyBoundaries(0) = aInitPos(i, 9) + aPartBBGlob(i, 0)
+ End If
+ If aInitPos(i, 9) + aPartBBGlob(i, 1) < aAssemblyBoundaries(1) Then
+ aAssemblyBoundaries(1) = aInitPos(i, 9) + aPartBBGlob(i, 1)
+ End If
+ If aInitPos(i, 10) + aPartBBGlob(i, 2) > aAssemblyBoundaries(2) Then
+ aAssemblyBoundaries(2) = aInitPos(i, 10) + aPartBBGlob(i, 2)
+ End If
+ If aInitPos(i, 10) + aPartBBGlob(i, 3) < aAssemblyBoundaries(3) Then
+ aAssemblyBoundaries(3) = aInitPos(i, 10) + aPartBBGlob(i, 3)
+ End If
+ If aInitPos(i, 11) + aPartBBGlob(i, 4) > aAssemblyBoundaries(4) Then
+ aAssemblyBoundaries(4) = aInitPos(i, 11) + aPartBBGlob(i, 4)
+ End If
+ If aInitPos(i, 11) + aPartBBGlob(i, 5) < aAssemblyBoundaries(5) Then
+ aAssemblyBoundaries(5) = aInitPos(i, 11) + aPartBBGlob(i, 5)
+ End If
+ End If
+ Next i
+
+ For i = 0 To cRelProd.Count - 1
+ relProd = cRelProd.Item(i)
+ If Not productIsInCollection(relProd, cDeact) Then
+ 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)
+ End If
+ Next i
+
+ End Sub
+
+ 'Public Function ArrayLen(a As Object) As Integer
+ ' If IsEmpty(a) Then
+ ' ArrayLen = 0
+ ' Else
+ ' ArrayLen = UBound(a) - LBound(a) + 1
+ ' End If
+ 'End Function
+
+ 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 productIsInCollection(objProd As Product, prodColl As ArrayList) As Boolean
+ Dim dummyObj As Product
+ productIsInCollection = False
+ For Each dummyObj In prodColl
+ If dummyObj.Name = objProd.Name Then
+ productIsInCollection = True
+ Exit For
+ End If
+ 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 collisionDetected(cClashes As Clashes, group1 As Group, group2 As Group) As Boolean
+ 'cRelevantProducts As Collection, cDeactivated As Collection
+
+ collisionDetected = False
+
+ 'define two groups
+ ' Dim group1 As Group
+ 'Dim group2 As Group
+ ' group1 = cGroups.Add
+ ' group2 = cGroups.Add
+ ' group1.AddExplicit product1
+ ' Dim relevantProduct As Product
+ ' For Each relevantProduct In cRelevantProducts
+ ' If Not relevantProduct.Name = product1.Name And Not productIsInCollection(relevantProduct, cDeactivated) Then
+ ' group2.AddExplicit relevantProduct
+ ' End If
+ ' Next relevantProduct
+ 'create a new clash analysis
+ Dim oClash As Clash
+ oClash = cClashes.Add
+ oClash.ComputationType = SPATypeLib.CatClashComputationType.catClashComputationTypeBetweenTwo
+ oClash.FirstGroup = group1
+ oClash.SecondGroup = group2
+ oClash.InterferenceType = SPATypeLib.CatClashInterferenceType.catClashInterferenceTypeClearance
+ 'oClash.Clearance = dCollSens
+ oClash.Compute
+ Dim cConflicts As Conflicts
+ cConflicts = oClash.Conflicts
+ If cConflicts.Count > 0 Then
+ 'MsgBox "Detected a collision: " & product1.Name
+ 'If at least one conflict value exceeds the collision sensitivity, it is a collision
+ Dim oConflict As Conflict
+ Dim c As Integer
+ For c = 1 To cConflicts.Count
+ oConflict = cConflicts.Item(c)
+ oConflict.Status = SPATypeLib.CatConflictStatus.catConflictStatusRelevant
+ If oConflict.Type = SPATypeLib.CatConflictType.catConflictTypeClash Then
+ If oConflict.Value < -dCollSens Then
+ collisionDetected = True
+ Debug.Print("Clash detected: " & oConflict.FirstProduct.Name & " - " & oConflict.SecondProduct.Name & " = " & oConflict.Value)
+ Exit For
+ End If
+ End If
+ Next c
+ End If
+ 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
+
+ Function productHasValidDisassDir(i1 As Integer, disassDir(,) As Object) As Boolean
+ productHasValidDisassDir = False
+ Dim j As Integer
+ For j = 0 To 11
+ If disassDir(i1, j) = 1 Then
+ productHasValidDisassDir = True
+ Exit For
+ End If
+ Next j
+ End Function
+
+ Function Tree(s1, q)
+
+ For Each s2 In s1.Products
+ Tree(s2, q)
+ Next
+
+ Dim parentAssy As Object
+ parentAssy = s1.Parent.Parent
+
+ If StrComp(TypeName(parentAssy), "Product") = 0 Then
+ parentAssy.ReferenceProduct.Products.Item(s1.Name).Name = CStr(s1.PartNumber) & CStr("." & q)
+ q = q + 1
+ End If
+
+ End Function
+
+ Private Sub RenameSingleLevel(ByRef oCurrentProd As Product)
+
+ On Error Resume Next
+
+ 'More declarations
+ Dim ItemToRename As Product
+ Dim ToRenamePartNumber As String
+ Dim lNumberOfItems As Long
+ Dim RenameArray(2000) As String
+ Dim i As Integer
+ Dim j As Integer
+ Dim k As Integer
+
+ oCurrentProd = oCurrentProd.ReferenceProduct 'You have to work with the "ReferenceProduct" object
+ lNumberOfItems = oCurrentProd.Products.Count
+
+ 'For i = 1 To lNumberOfItems 'Clear out the rename array
+ ' RenameArray(i) = "" 'Don't know if this is necessary
+ 'Next
+
+ 'Run through this loop once, to set everything to a dummy name, to avoid naming conflicts
+ For i = 1 To lNumberOfItems 'Cycle through the assembly's children
+ ItemToRename = oCurrentProd.Products.Item(i) 'Declare which item we are working on
+
+ ToRenamePartNumber = ItemToRename.PartNumber 'Get the Part Number
+ 'ToRenamePartNumber = ItemToRename.DescriptionRef 'Toggle these two lines for testing
+
+ RenameArray(i) = ToRenamePartNumber 'Building the list of part names for the numbering loop
+
+ k = 0 'Numbering Loop
+ For j = 1 To i 'This loop checks and sets the instance number
+ If RenameArray(j) = ToRenamePartNumber Then
+ k = k + 1
+ End If
+ Next
+ CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
+ 'MsgBox ItemToRename.Name & " / " & ToRenamePartNumber & "." & k 'This line is for testing only
+ ItemToRename.Name = ToRenamePartNumber & "TEMP." & k 'Set the new instance name, to a TEMP dummy value
+
+ Next
+
+ 'Run through this loop to set the name finally, then the recursion call
+ For i = 1 To lNumberOfItems
+ ItemToRename = oCurrentProd.Products.Item(i)
+
+ ToRenamePartNumber = ItemToRename.PartNumber 'Toggle these two lines for testing
+ 'ToRenamePartNumber = ItemToRename.DescriptionRef 'Toggle these two lines for testing
+
+ RenameArray(i) = ToRenamePartNumber
+
+ k = 0
+ For j = 1 To i
+ If RenameArray(j) = ToRenamePartNumber Then
+ k = k + 1
+ End If
+ Next
+
+ CATIA.StatusBar = ItemToRename.Name & " > " & ToRenamePartNumber & "." & k
+ 'MsgBox ItemToRename.Name & " / " & ToRenamePartNumber & "." & k 'For testing
+
+ ItemToRename.Name = ToRenamePartNumber & "." & k 'Set the new instance name final
+
+ If ItemToRename.Products.Count <> 0 Then 'Recursive Call for version 0.1.2
+ If oList.exists(ItemToRename.PartNumber) Then GoTo Finish
+ If ItemToRename.PartNumber = ItemToRename.ReferenceProduct.Parent.Product.PartNumber Then oList.Add(ItemToRename.PartNumber, 1)
+ Call RenameSingleLevel(ItemToRename)
+ End If
+
+Finish:
+ Next
+
+ End Sub
+
+ Function GetProductIndex(objProd As Product, cProds As ArrayList) As Integer
+ Dim produkt As Product
+ Dim intAns As Integer
+ intAns = 0
+ For Each produkt In cProds
+ If produkt.Name = objProd.Name Then
+ GetProductIndex = intAns
+ Exit Function
+ End If
+ intAns = intAns + 1
+ Next produkt
+ Return intAns
+ End Function
+
+ 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 ParentSubassemblyIndex(objProd As Product, cRelProd As ArrayList) As Integer
+ 'CATIA detects collisions on Part level, but for tier determination we need to know which
+ 'subassembly the crashed Part belongs to (and get its index, because that's how we retrieve
+ 'assembly tier quickly
+
+ 'Try to assign parent
+ Dim oFatherProduct As Product
+ oFatherProduct = Nothing
+ On Error Resume Next
+ oFatherProduct = objProd.Parent.Parent
+ On Error GoTo 0
+
+ If oFatherProduct Is Nothing Then
+ 'Current part or subassembly lies on the top level of the specification tree
+ ParentSubassemblyIndex = GetProductIndex(objProd, cRelProd)
+ Else
+ If productIsInCollection(objProd, cRelProd) Then
+ 'Part or subassembly is on the same hierarchy level as the moving part
+ ParentSubassemblyIndex = GetProductIndex(objProd, cRelProd)
+ Else
+ 'Have to try recursively on the higher level of assembly structure
+ ParentSubassemblyIndex(oFatherProduct, cRelProd)
+ End If
+ End If
+
+ 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
+
+
+End Class
+
diff --git a/CatiaNetTest/bin/Debug/CatiaNetTest.exe b/CatiaNetTest/bin/Debug/CatiaNetTest.exe
index 94e67f4fff98419dab1bceefbf1eac9e103fa1af..fa991fb5175975f1cdbde8fe6a0c9800d804d76f 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 c43d247e2fbedcf6d65a35dde4706f17eb794bbb..5dfd60943eb0b41beaad1d9baf7ba04a2a5823cb 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 94e67f4fff98419dab1bceefbf1eac9e103fa1af..fa991fb5175975f1cdbde8fe6a0c9800d804d76f 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 c43d247e2fbedcf6d65a35dde4706f17eb794bbb..5dfd60943eb0b41beaad1d9baf7ba04a2a5823cb 100644
Binary files a/CatiaNetTest/obj/Debug/CatiaNetTest.pdb and b/CatiaNetTest/obj/Debug/CatiaNetTest.pdb differ
diff --git a/CatiaNetTest/obj/Debug/CatiaNetTest.vbproj.GenerateResource.Cache b/CatiaNetTest/obj/Debug/CatiaNetTest.vbproj.GenerateResource.Cache
index 1a031fdb392ea88d0c7157e6d696f89b5477d744..594ce36497884ed1df0d337248f4c486c2c79d72 100644
Binary files a/CatiaNetTest/obj/Debug/CatiaNetTest.vbproj.GenerateResource.Cache and b/CatiaNetTest/obj/Debug/CatiaNetTest.vbproj.GenerateResource.Cache differ
diff --git a/CatiaNetTest/obj/Debug/CatiaNetTest.vbprojAssemblyReference.cache b/CatiaNetTest/obj/Debug/CatiaNetTest.vbprojAssemblyReference.cache
index b0030fbd7ec997cca7076394568b815bd1f625f7..98ac912058021e08fe3a1b745a79cf7499d688b6 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 766eddbc32003fee7eb3f40f30bbdb2a5fe285a6..20323601aaea24770b5ca260161b363f78dd2615 100644
Binary files a/CatiaNetTest/obj/Debug/DesignTimeResolveAssemblyReferences.cache and b/CatiaNetTest/obj/Debug/DesignTimeResolveAssemblyReferences.cache differ