Skip to content
Snippets Groups Projects
Commit 7f702fa9 authored by Sören Münker's avatar Sören Münker
Browse files

Copied from catvba to vb.net; Still a lot of portation errors

parent 9279047a
No related branches found
No related tags found
No related merge requests found
Expand all Show whitespace changes
Inline Side-by-side
Showing
with 4903 additions and 0 deletions
AssemblyTiers2.vb 0 → 100644
+ 1673
− 0
View file @ 7f702fa9
Imports Microsoft.VisualBasic
Public Class AssemblyTiers2
Public intStep As Integer
Public dCollSens As Double
Public intParts As Integer
Public primaryFasteners As New Collection
Public secondaryFasteners As New Collection
Public cAllProducts As New Collection
Public cRelevantProducts As New Collection
Public cBaseProducts As New Collection
Public aRemovalDistances() As Single
Public aAssemblyBoundaries(5) As Double
Public aPartBBGlob() As Single
Public aInitPos() As Double
Public sChosenDirection As String
Public oList As Variant
Sub CatMain()
'On Error Resume Next
Debug.Print "========================================================"
Dim document As ProductDocument
Set document = CATIA.ActiveDocument
'Extraction of all "leaf" products to cAllProducts
ExtractProducts document.Product
'Collection of "leaf" Products (without nested Products)
Set oInstances = cAllProducts
Dim i As Integer
Dim outputText As String
intParts = oInstances.Count
outputText = "This assembly contains " + CStr(oInstances.Count) + " parts" + 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
Set oSel = CATIA.ActiveDocument.Selection
Set baseSel = oSel
'Create an array for CATParts
ReDim strArray(0)
strArray(0) = "Part"
'Display a messagebox prompting the user to select CATIA parts
MsgBox "Please select the assembly's base components"
sStatus = baseSel.SelectElement3(strArray, "Select parts", False, 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
'Collision parameters
intStep = 1
dCollSens = 1
CollisionParams.Show
Debug.Print "Step = " + CStr(intStep)
Debug.Print "Sensitivity = " + CStr(dCollSens)
'Separation of components
DeactivateFasteners document.Product
'Display the number of relevant parts
outputText = CStr(cRelevantProducts.Count) + " parts 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 Double
BBStartTime = Timer
'This is used to check whether a product must be moved in current iteration
ReDim bMoveable(cRelevantProducts.Count - 1) As Boolean
For i = 1 To cRelevantProducts.Count
'########## this won't work if part document name is not = part number ######
Dim partI As Part
Dim prodI As Product
Set 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
' Set prodI = cRelevantProducts.Item(i)
' Dim docName As String
' docName = prodI.PartNumber + ".CATPart"
' Dim oPartDoc As PartDocument
' Dim sPartPath As String
' sPartPath = prodI.GetMasterShapeRepresentationPathName
' Set 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
bMoveable(i - 1) = False
Else
bMoveable(i - 1) = True
End If
Next i
Dim BBSecondsElapsed As Double
BBSecondsElapsed = Round(Timer - BBStartTime, 2)
MsgBox "Bounding box calculation took " & CStr(BBSecondsElapsed) & " seconds"
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)
'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_k As Integer 'secondary direction index 1..10
Dim total_coll As Long 'counter of total collision detections
Dim cDeactivated As New Collection 'really deactivated products
Dim cVirtual As New Collection 'these funny green parts
Dim precedenceMatrix() As Single
ReDim disassDir(cRelevantProducts.Count - 1, 11)
ReDim aTiers(cRelevantProducts.Count - 1) As Integer
ReDim aInitPos(cRelevantProducts.Count - 1, 11) 'remember initial positions of the products
ReDim bInitPosRecorded(cRelevantProducts.Count - 1) As Boolean
ReDim precedenceMatrix(cRelevantProducts.Count - 1, cRelevantProducts.Count - 1)
ReDim bDeactivated(cRelevantProducts.Count - 1) As Boolean
intI = cRelevantProducts.Count '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 = 1 'index of current part in collection of relevant products
int_i_cycle = 1 'counter for the current tier iteration
int_j = 1 '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
Set 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
Set cClashes = CATIA.ActiveDocument.Product.GetTechnologicalObject("Clashes")
'access the groups technology object
Dim cGroups As Groups
Set cGroups = CATIA.ActiveDocument.Product.GetTechnologicalObject("Groups")
'calculate initial clashes (due to imprecise modelling or STEP file export...)
' Dim cInitClashes As New Collection
' Dim oInitClash 'As Clash
' 'Set oInitClash = cInitClashes.Add
' oInitClash.ComputationType = catClashComputationTypeBetweenAll
' oInitClash.Compute
' Dim cInitConflicts As Conflicts
' Set 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 Double
StartTime = Timer
Do
'Processing next Product
Dim product1 As Product
Set 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 - 1) 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
Set oPosition1 = product1.Position
oPosition1.GetComponents initPos
If bInitPosRecorded(int_i - 1) = False Then
Dim ip As Integer
For ip = 0 To 11
aInitPos(int_i - 1, ip) = initPos(ip)
Next ip
bInitPosRecorded(int_i - 1) = 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
Set group1 = cGroups.Add
group1.AddExplicit product1
'Create a Group of Products that this product shouldn't collide with
Dim group2 As Group
Set group2 = cGroups.Add
Dim iStaticProduct As Integer
For iStaticProduct = 1 To cRelevantProducts.Count
If iStaticProduct <> int_i And Not bDeactivated(iStaticProduct - 1) 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 - 1) = 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 - 1) & "]"
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
Set 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
Set oConflict1 = detConflicts.Item(ic)
oConflict1.Status = catConflictStatusRelevant
If oConflict1.Type = catConflictTypeClash Then
If oConflict1.Value < -dCollSens Then
Dim secProduct As Product
'get the product we collided with
Set 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
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 - 1, 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
Set 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 = 1
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 = 1 To cRelevantProducts.Count
If productIsInCollection(cRelevantProducts.Item(p), cBaseProducts) Then
'base product always has tier 0 (doesn't get reversed)
aTiers(p - 1) = 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 - 1) > 0 Then
'save tier
aTiers(p - 1) = intTier
'decrease the counter of active products in assembly
intI = intI - 1
'change visuals for "virtual" products
Dim virtSelection As Selection
Set virtSelection = document.Selection
virtSelection.Clear
virtSelection.Add cRelevantProducts.Item(p)
Set visProperties1 = virtSelection.VisProperties
visProperties1.SetRealColor 80, 255, 160, 1
virtSelection.Clear
'remember virtual green products
'cVirtual.Add cRelevantProducts.Item(p)
'fix position
bMoveable(p - 1) = False
End If
'product from higher tier
If productHasValidDisassDir(p, disassDir) And aTiers(p - 1) = intTier - 1 Then
'deactivate
Dim selection2 As Selection
Set 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 - 1) = 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 = 1
int_i_cycle = 1
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 - 1, int_j - 1) = 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
SecondsElapsed = Round(Timer - StartTime, 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 = 1 To cRelevantProducts.Count
If Not productIsInCollection(cRelevantProducts.Item(p1), cBaseProducts) Then
Dim oPosition4 As Object
Set oPosition4 = cRelevantProducts.Item(p1).Position
Dim aPos(11)
For comp = 0 To 11
aPos(comp) = aInitPos(p1 - 1, comp)
Next comp
oPosition4.SetComponents aPos
Dim selection4 As Selection
Set 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
Set 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
Set 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
Set 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
Exit For
End If
Next intAxis
Next int_i
'Association of components belonging to sequential tiers
Dim cClashes1 As Clashes
Dim oClash1 'As Clash
Set oClash1 = cClashes.Add
oClash1.ComputationType = catClashComputationTypeBetweenAll
oClash1.Compute
Dim cInitConflicts As Conflicts
Set 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 = GetProductIndex(initConfl.FirstProduct, cRelevantProducts)
secondIndex = GetProductIndex(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
' Set group11 = cGroups.Add
' Set group21 = cGroups.Add
' group11.AddExplicit cRelevantProducts.Item(int_i)
' group21.AddExplicit cRelevantProducts.Item(int_j)
' 'create a new clash analysis
' Dim oClash 'As Clash
' Set oClash = cClashes.Add
' oClash.ComputationType = catClashComputationTypeBetweenTwo
' oClash.FirstGroup = group11
' oClash.SecondGroup = group21
' oClash.InterferenceType = catClashInterferenceTypeContact
' oClash.Compute
' Dim cConflicts As Conflicts
' Set 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
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.ActiveWorkbook.Sheets.Add.Name = "Precedence Matrix"
Set objSheet1 = objExcel.ActiveWorkbook.Worksheets(2)
objSheet1.Name = "Assembly Directions"
Set 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 = 1 To cRelevantProducts.Count
objSheet1.Cells(int_i + 1, 1).Value = cRelevantProducts.Item(int_i).Name
For intAxis = 0 To intJ - 1
objSheet1.Cells(int_i + 1, 2 + intAxis).Value = disassDir(int_i - 1, intAxis)
Next intAxis
objSheet1.Cells(int_i + 1, intJ + 2).Value = aTiers(int_i - 1)
Next int_i
'Precedence relations
For int_i = 1 To cRelevantProducts.Count
For int_j = 1 To cRelevantProducts.Count
objSheet2.Cells(int_i, int_j).Value = precedenceMatrix(int_i - 1, int_j - 1)
Next int_j
Next int_i
End Sub
Sub ExtractProducts(oCurrentProduct As Product)
Dim oCurrentTreeNode As Product
Dim i As Integer
For i = 1 To oCurrentProduct.Products.Count
Set oCurrentTreeNode = oCurrentProduct.Products.Item(i)
'recursive
If oCurrentTreeNode.Products.Count > 0 Then
ExtractProducts oCurrentTreeNode
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
cAllProducts.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
Set 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
Set oTestPart = Nothing
On Error Resume Next
Set 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
Set oTestProduct = Nothing
On Error Resume Next
Set 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 New Collection
'On the top level of product tree
'Set objParts = objProduct.Products
'Recursive
Set objParts = cAllProducts
Dim i As Integer
Dim selection1 As Selection
Set selection1 = CATIA.ActiveDocument.Selection
selection1.Clear
Dim intFasteners As Integer
intFasteners = 0
For i = 1 To objParts.Count
Dim sName As String
Dim prod As Product
Dim primFastSize As Integer
Set prod = objParts.Item(i)
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") Or InStr(sName, "schraube") > 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 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 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
Default 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
Set part1 = partDocument1.Part
Set hybridShapeFactory1 = part1.hybridShapeFactory
Dim axiscoord(2)
Dim axissyst
Dim axisSystem As axisSystem
Set axisSystem = part1.AxisSystems.Item(1)
Set axissyst = axisSystem
Set axisref = axisSystem
ref_name_systaxis = axissyst.Name
axissyst.IsCurrent = 1
axissyst.Name = "BBoxAxis"
axname = axissyst.Name
'Get Product's Position (rotation and translation)
'(for now: relative to the parent product!)
Dim PositionArray(11)
Dim oPosition As Object
Set 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))
Set originpoint = hybridShapeFactory1.AddNewPointCoord(originCoord(0), originCoord(1), originCoord(2))
Set axisref = part1.CreateReferenceFromObject(originpoint)
axissyst.GetXAxis axiscoord
Set hybridShapeD1 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetYAxis axiscoord
Set hybridShapeD2 = hybridShapeFactory1.AddNewDirectionByCoord(axiscoord(0), axiscoord(1), axiscoord(2))
axissyst.GetZAxis axiscoord
Set 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
Set Plane_line_1 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD1, 0, 0, False)
Dim Plane_line_2 As HybridShapeLinePtDir
Set Plane_line_2 = hybridShapeFactory1.AddNewLinePtDir(originpoint, hybridShapeD2, 0, 0, False)
Dim oBodies As Bodies
Set 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
Set bodies1 = part1.Bodies
Set body1 = bodies1.Add()
body1.Name = "Bounding Box." & j
Set hybridBodies1 = body1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Add
hybridBody1.Name = "definition_points"
'Pick a face of the part to use for HybridShapeExtract
Set 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)
'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
Set reference1 = faceSel.Item(f).Value
Debug.Print TypeName(reference1)
Dim hybridShapeExtract1 As HybridShapeExtract
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)
hybridShapeExtract1.PropagationType = 1 'point continuity
hybridShapeExtract1.ComplementaryExtract = False
hybridShapeExtract1.IsFederated = False
Set reference1 = hybridShapeExtract1
'Create the 6 Extrenum items for the Solid/Surf. May not be single points, will be solved with next points
Set HybridShapeExtremum1 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD1, 1)
Set HybridShapeExtremum2 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD1, 0)
Set HybridShapeExtremum3 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD2, 1)
Set HybridShapeExtremum4 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD2, 0)
Set HybridShapeExtremum5 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD3, 1)
Set HybridShapeExtremum6 = hybridShapeFactory1.AddNewExtremum(reference1, hybridShapeD3, 0)
' Creates Geometrical Set under the Solid, to contain the construction elements
Dim hybridBody2 As HybridBody
Set 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 offset planes to these points
Dim Ref1 As Reference
Set Ref1 = part1.CreateReferenceFromObject(HybridShapeExtremum1)
Dim Point1 As HybridShapePointCoord
Set Point1 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref1)
hybridBody2.AppendHybridShape Point1
Set point_ref11 = part1.CreateReferenceFromObject(Point1)
Dim Ref2 As Reference
Set Ref2 = part1.CreateReferenceFromObject(HybridShapeExtremum2)
Dim Point2 As HybridShapePointCoord
Set Point2 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref2)
hybridBody2.AppendHybridShape Point2
Set point_ref12 = part1.CreateReferenceFromObject(Point2)
Dim Ref3 As Reference
Set Ref3 = part1.CreateReferenceFromObject(HybridShapeExtremum3)
Dim Point3 As HybridShapePointCoord
Set Point3 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref3)
hybridBody2.AppendHybridShape Point3
Set point_ref13 = part1.CreateReferenceFromObject(Point3)
Dim Ref4 As Reference
Set Ref4 = part1.CreateReferenceFromObject(HybridShapeExtremum4)
Dim Point4 As HybridShapePointCoord
Set Point4 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref4)
hybridBody2.AppendHybridShape Point4
Set point_ref14 = part1.CreateReferenceFromObject(Point4)
Dim Ref5 As Reference
Set Ref5 = part1.CreateReferenceFromObject(HybridShapeExtremum5)
Dim Point5 As HybridShapePointCoord
Set Point5 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref5)
hybridBody2.AppendHybridShape Point5
Set point_ref5 = part1.CreateReferenceFromObject(Point5)
Dim Ref6 As Reference
Set Ref6 = part1.CreateReferenceFromObject(HybridShapeExtremum6)
Dim Point6 As HybridShapePointCoord
Set Point6 = hybridShapeFactory1.AddNewPointCoordWithReference(0, 0, 0, Ref6)
hybridBody2.AppendHybridShape Point6
Set 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 Variant
Dim absCoord(2) As Variant
Dim TheSPAWorkbench As Workbench
Set 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
ReDim aBBDistances(5) As Double
'8 corner points of the Part Bounding Box (BB) in local coordinates (8x3 array)
ReDim aBBCornersLocal(7, 2) As Double
'max_X_loc
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref11)
TheMeasurable.GetPoint coord
aBBDistances(0) = coord(0)
Call Coord_Transform(coord, absCoord, objProduct, True)
Debug.Print Point1.Name & " (" & Ref1.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]"
'min_X_loc
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref12)
TheMeasurable.GetPoint coord
aBBDistances(1) = coord(0)
Call Coord_Transform(coord, absCoord, objProduct, True)
Debug.Print Point2.Name & " (" & Ref2.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]"
'max_Y_loc
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref13)
TheMeasurable.GetPoint coord
aBBDistances(2) = coord(1)
Call Coord_Transform(coord, absCoord, objProduct, True)
Debug.Print Point3.Name & " (" & Ref3.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]"
'min_Y_loc
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref14)
TheMeasurable.GetPoint coord
aBBDistances(3) = coord(1)
Call Coord_Transform(coord, absCoord, objProduct, True)
Debug.Print Point4.Name & " (" & Ref4.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]"
'max_Z_loc
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref5)
TheMeasurable.GetPoint coord
aBBDistances(4) = coord(2)
Call Coord_Transform(coord, absCoord, objProduct, True)
Debug.Print Point5.Name & " (" & Ref5.DisplayName & "): [" & absCoord(0) & " " & absCoord(1) & " " & absCoord(2) & "]"
'min_Z_loc
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(point_ref6)
TheMeasurable.GetPoint coord
aBBDistances(5) = coord(2)
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 - 1, 0) Then
aPartBBGlob(i - 1, 0) = CCC(0)
End If
If CCC(0) < aPartBBGlob(i - 1, 1) Then
aPartBBGlob(i - 1, 1) = CCC(0)
End If
If CCC(1) > aPartBBGlob(i - 1, 2) Then
aPartBBGlob(i - 1, 2) = CCC(1)
End If
If CCC(1) < aPartBBGlob(i - 1, 3) Then
aPartBBGlob(i - 1, 3) = CCC(1)
End If
If CCC(2) > aPartBBGlob(i - 1, 4) Then
aPartBBGlob(i - 1, 4) = CCC(2)
End If
If CCC(2) < aPartBBGlob(i - 1, 5) Then
aPartBBGlob(i - 1, 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 RecalculateRemovalDistances(cRelProd As Collection, cDeact As Collection)
ReDim 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
Set relProd = cRelProd.Item(i + 1)
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
Set relProd = cRelProd.Item(i + 1)
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 Variant) 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 Boolean
'***********************************************
'*
'* 3x3 matrix inverse calculation (direct)
'*
'***********************************************
Dim dDet As Double
ReDim aInv(8)
Inv3x3 = False
dDet = Det3x3(dX11, dX12, dX13, dX21, dX22, dX23, dX31, dX32, dX33)
If dDet = 0 Then Exit Function
aInv(0) = (dX22 * dX33 - dX23 * dX32) / Abs(dDet)
aInv(1) = (dX13 * dX32 - dX12 * dX33) / Abs(dDet)
aInv(2) = (dX12 * dX23 - dX13 * dX22) / Abs(dDet)
aInv(3) = (dX23 * dX31 - dX21 * dX33) / Abs(dDet)
aInv(4) = (dX11 * dX33 - dX13 * dX31) / Abs(dDet)
aInv(5) = (dX13 * dX21 - dX11 * dX23) / Abs(dDet)
aInv(6) = (dX21 * dX32 - dX22 * dX31) / Abs(dDet)
aInv(7) = (dX12 * dX31 - dX11 * dX32) / Abs(dDet)
aInv(8) = (dX11 * dX22 - dX12 * dX21) / Abs(dDet)
Inv3x3 = True
End Function
Sub Coord_Transform(aRel() As Variant, aAbs() As Variant, oProduct As Product, bRecursively As Boolean)
Dim vProduct As Object, vCoord(11)
Dim oFatherProduct As Product
Dim aInv() As Double
'Exit condition, empty object
If oProduct Is Nothing Then Exit Sub
'Redim absolute coords matrix
On Error Resume Next
ReDim aAbs(2)
On Error GoTo 0
'Calculate product coordinates
Set vProduct = oProduct
vProduct.Position.GetComponents vCoord
'Calculate inverse matrix
If 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
Else
'MsgBox "Error, degenerate transformation", vbOKOnly
Exit Sub
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
Set oFatherProduct = Nothing
On Error Resume Next
Set 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 Collection) 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 < 7 Then
'Attention: for now it is assumed that all products are on the top level of specification tree
If intDir = 1 Then
moveArray(9) = intS
End If
If intDir = 2 Then
moveArray(10) = intS
End If
If intDir = 3 Then
moveArray(11) = intS
End If
If intDir = 4 Then
moveArray(9) = -intS
End If
If intDir = 5 Then
moveArray(10) = -intS
End If
If intDir = 6 Then
moveArray(11) = -intS
End If
Else 'movement along local axis
Dim oPosition As Object
Set oPosition = objProd.Position
oPosition.GetComponents axisArray
If intDir = 7 Then
moveArray(9) = axisArray(0) * intS
moveArray(10) = axisArray(1) * intS
moveArray(11) = axisArray(2) * intS
End If
If intDir = 8 Then
moveArray(9) = axisArray(3) * intS
moveArray(10) = axisArray(4) * intS
moveArray(11) = axisArray(5) * intS
End If
If intDir = 9 Then
moveArray(9) = axisArray(6) * intS
moveArray(10) = axisArray(7) * intS
moveArray(11) = axisArray(8) * intS
End If
If intDir = 10 Then
moveArray(9) = -axisArray(0) * intS
moveArray(10) = -axisArray(1) * intS
moveArray(11) = -axisArray(2) * intS
End If
If intDir = 11 Then
moveArray(9) = -axisArray(3) * intS
moveArray(10) = -axisArray(4) * intS
moveArray(11) = -axisArray(5) * intS
End If
If intDir = 12 Then
moveArray(9) = -axisArray(6) * intS
moveArray(10) = -axisArray(7) * intS
moveArray(11) = -axisArray(8) * intS
End If
End If
Set 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
' Set group1 = cGroups.Add
'Set 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
Set oClash = cClashes.Add
oClash.ComputationType = catClashComputationTypeBetweenTwo
oClash.FirstGroup = group1
oClash.SecondGroup = group2
oClash.InterferenceType = catClashInterferenceTypeClearance
'oClash.Clearance = dCollSens
oClash.Compute
Dim cConflicts As Conflicts
Set 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
Set oConflict = cConflicts.Item(c)
oConflict.Status = catConflictStatusRelevant
If oConflict.Type = 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
Set oPosition = objProd.Position
oPosition.GetComponents posArray
If posArray(9) > aRemovalDistances(i1 - 1, 0) Then
productReachedFinalPosition = True
'MsgBox "X+ removal distance reached by " & objProd.Name
End If
If posArray(9) < aRemovalDistances(i1 - 1, 1) Then
productReachedFinalPosition = True
'MsgBox "X- removal distance reached by " & objProd.Name
End If
If posArray(10) > aRemovalDistances(i1 - 1, 2) Then
productReachedFinalPosition = True
'MsgBox "Y+ removal distance reached by " & objProd.Name
End If
If posArray(10) < aRemovalDistances(i1 - 1, 3) Then
productReachedFinalPosition = True
'MsgBox "Y- removal distance reached by " & objProd.Name
End If
If posArray(11) > aRemovalDistances(i1 - 1, 4) Then
productReachedFinalPosition = True
'MsgBox "Z+ removal distance reached by " & objProd.Name
End If
If posArray(11) < aRemovalDistances(i1 - 1, 5) Then
productReachedFinalPosition = True
'MsgBox "Z- removal distance reached by " & objProd.Name
End If
End Function
Function productHasValidDisassDir(i1 As Integer, disassDir() As Variant) As Boolean
productHasValidDisassDir = False
Dim j As Integer
For j = 0 To 11
If disassDir(i1 - 1, 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
Set 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
Set 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
Set 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
Set 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 Collection) 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
End Function
End Class
CatiaNetTest.sln 0 → 100644
+ 24
− 0
View file @ 7f702fa9

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 14
VisualStudioVersion = 14.0.25420.1
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F184B08F-C81C-45F6-A57F-5ABD9991F28F}") = "CatiaNetTest", "CatiaNetTest\CatiaNetTest.vbproj", "{BE15D79B-EF5F-46CE-8D88-72F4386BCF6F}"
EndProject
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{B80168DE-DFE2-413B-ABF4-882E20B80DE9}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{BE15D79B-EF5F-46CE-8D88-72F4386BCF6F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{BE15D79B-EF5F-46CE-8D88-72F4386BCF6F}.Debug|Any CPU.Build.0 = Debug|Any CPU
{BE15D79B-EF5F-46CE-8D88-72F4386BCF6F}.Release|Any CPU.ActiveCfg = Release|Any CPU
{BE15D79B-EF5F-46CE-8D88-72F4386BCF6F}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
EndGlobal
CatiaNetTest/App.config 0 → 100644
+ 6
− 0
View file @ 7f702fa9
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5.2" />
</startup>
</configuration>
\ No newline at end of file
CatiaNetTest/AssemblyTiers2.vb 0 → 100644
+ 1677
− 0
View file @ 7f702fa9
This diff is collapsed.
CatiaNetTest/CatiaNetTest.vbproj 0 → 100644
+ 915
− 0
View file @ 7f702fa9
This diff is collapsed.
CatiaNetTest/Form1.Designer.vb 0 → 100644
+ 87
− 0
View file @ 7f702fa9
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class Form1
Inherits System.Windows.Forms.Form
'Form overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Me.Label1 = New System.Windows.Forms.Label()
Me.Button1 = New System.Windows.Forms.Button()
Me.Label2 = New System.Windows.Forms.Label()
Me.Button2 = New System.Windows.Forms.Button()
Me.SuspendLayout()
'
'Label1
'
Me.Label1.AutoSize = True
Me.Label1.Location = New System.Drawing.Point(92, 49)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(139, 13)
Me.Label1.TabIndex = 0
Me.Label1.Text = "Click here to start CATIA V5"
'
'Button1
'
Me.Button1.Location = New System.Drawing.Point(249, 44)
Me.Button1.Name = "Button1"
Me.Button1.Size = New System.Drawing.Size(114, 23)
Me.Button1.TabIndex = 1
Me.Button1.Text = "Start"
Me.Button1.UseVisualStyleBackColor = True
'
'Label2
'
Me.Label2.AutoSize = True
Me.Label2.Location = New System.Drawing.Point(92, 96)
Me.Label2.Name = "Label2"
Me.Label2.Size = New System.Drawing.Size(109, 13)
Me.Label2.TabIndex = 2
Me.Label2.Text = "Start collision analysis"
'
'Button2
'
Me.Button2.Location = New System.Drawing.Point(249, 96)
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.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.Controls.Add(Me.Button2)
Me.Controls.Add(Me.Label2)
Me.Controls.Add(Me.Button1)
Me.Controls.Add(Me.Label1)
Me.Name = "Form1"
Me.Text = "CATIA .NET TEST"
Me.ResumeLayout(False)
Me.PerformLayout()
End Sub
Friend WithEvents Label1 As Label
Friend WithEvents Button1 As Button
Friend WithEvents Label2 As Label
Friend WithEvents Button2 As Button
End Class
CatiaNetTest/Form1.resx 0 → 100644
+ 120
− 0
View file @ 7f702fa9
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>
\ No newline at end of file
CatiaNetTest/Form1.vb 0 → 100644
+ 42
− 0
View file @ 7f702fa9
Imports INFITF
Imports MECMOD
Imports NavigatorTypeLib
Imports ProductStructureTypeLib
Imports SPATypeLib
Public Class Form1
Dim myCATIA As INFITF.Application
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Try
myCATIA = GetObject(, "CATIA.Application")
Catch ex As Exception
myCATIA = CreateObject("CATIA.Application")
End Try
myCATIA.Visible = True
myCATIA.DisplayFileAlerts = True
End Sub
Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim myAssemblyTiers As AssemblyTiers2 = New AssemblyTiers2()
Try
myAssemblyTiers.CatMain(myCATIA)
Catch ex As Exception
End Try
End Sub
End Class
CatiaNetTest/My Project/Application.Designer.vb 0 → 100644
+ 38
− 0
View file @ 7f702fa9
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
'NOTE: This file is auto-generated; do not modify it directly. To make changes,
' or if you encounter build errors in this file, go to the Project Designer
' (go to Project Properties or double-click the My Project node in
' Solution Explorer), and make changes on the Application tab.
'
Partial Friend Class MyApplication
<Global.System.Diagnostics.DebuggerStepThroughAttribute()> _
Public Sub New()
MyBase.New(Global.Microsoft.VisualBasic.ApplicationServices.AuthenticationMode.Windows)
Me.IsSingleInstance = false
Me.EnableVisualStyles = true
Me.SaveMySettingsOnExit = true
Me.ShutDownStyle = Global.Microsoft.VisualBasic.ApplicationServices.ShutdownMode.AfterMainFormCloses
End Sub
<Global.System.Diagnostics.DebuggerStepThroughAttribute()> _
Protected Overrides Sub OnCreateMainForm()
Me.MainForm = Global.CatiaNetTest.Form1
End Sub
End Class
End Namespace
CatiaNetTest/My Project/Application.myapp 0 → 100644
+ 11
− 0
View file @ 7f702fa9
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>true</MySubMain>
<MainForm>Form1</MainForm>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<ApplicationType>0</ApplicationType>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>
CatiaNetTest/My Project/AssemblyInfo.vb 0 → 100644
+ 35
− 0
View file @ 7f702fa9
Imports System
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("CatiaNetTest")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("")>
<Assembly: AssemblyProduct("CatiaNetTest")>
<Assembly: AssemblyCopyright("Copyright © 2020")>
<Assembly: AssemblyTrademark("")>
<Assembly: ComVisible(False)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("287b5ad0-cd38-4e1c-9b0e-5761c063aa7f")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.0.0.0")>
<Assembly: AssemblyFileVersion("1.0.0.0")>
CatiaNetTest/My Project/Resources.Designer.vb 0 → 100644
+ 63
− 0
View file @ 7f702fa9
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Imports System
Namespace My.Resources
'This class was auto-generated by the StronglyTypedResourceBuilder
'class via a tool like ResGen or Visual Studio.
'To add or remove a member, edit your .ResX file then rerun ResGen
'with the /str option, or rebuild your VS project.
'''<summary>
''' A strongly-typed resource class, for looking up localized strings, etc.
'''</summary>
<Global.System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "4.0.0.0"), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.Microsoft.VisualBasic.HideModuleNameAttribute()> _
Friend Module Resources
Private resourceMan As Global.System.Resources.ResourceManager
Private resourceCulture As Global.System.Globalization.CultureInfo
'''<summary>
''' Returns the cached ResourceManager instance used by this class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend ReadOnly Property ResourceManager() As Global.System.Resources.ResourceManager
Get
If Object.ReferenceEquals(resourceMan, Nothing) Then
Dim temp As Global.System.Resources.ResourceManager = New Global.System.Resources.ResourceManager("CatiaNetTest.Resources", GetType(Resources).Assembly)
resourceMan = temp
End If
Return resourceMan
End Get
End Property
'''<summary>
''' Overrides the current thread's CurrentUICulture property for all
''' resource lookups using this strongly typed resource class.
'''</summary>
<Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Friend Property Culture() As Global.System.Globalization.CultureInfo
Get
Return resourceCulture
End Get
Set
resourceCulture = value
End Set
End Property
End Module
End Namespace
CatiaNetTest/My Project/Resources.resx 0 → 100644
+ 120
− 0
View file @ 7f702fa9
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>
\ No newline at end of file
CatiaNetTest/My Project/Settings.Designer.vb 0 → 100644
+ 73
− 0
View file @ 7f702fa9
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.42000
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "11.0.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings), MySettings)
#Region "My.Settings Auto-Save Functionality"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(ByVal sender As Global.System.Object, ByVal e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.CatiaNetTest.My.MySettings
Get
Return Global.CatiaNetTest.My.MySettings.Default
End Get
End Property
End Module
End Namespace
CatiaNetTest/My Project/Settings.settings 0 → 100644
+ 7
− 0
View file @ 7f702fa9
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
<Settings />
</SettingsFile>
CatiaNetTest/bin/Debug/CatiaNetTest.exe 0 → 100644
+ 0
− 0
View file @ 7f702fa9
File added
CatiaNetTest/bin/Debug/CatiaNetTest.exe.config 0 → 100644
+ 6
− 0
View file @ 7f702fa9
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5.2" />
</startup>
</configuration>
\ No newline at end of file
CatiaNetTest/bin/Debug/CatiaNetTest.pdb 0 → 100644
+ 0
− 0
View file @ 7f702fa9
File added
CatiaNetTest/bin/Debug/CatiaNetTest.vshost.exe 0 → 100644
+ 0
− 0
View file @ 7f702fa9
File added
CatiaNetTest/bin/Debug/CatiaNetTest.vshost.exe.config 0 → 100644
+ 6
− 0
View file @ 7f702fa9
<?xml version="1.0" encoding="utf-8" ?>
<configuration>
<startup>
<supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.5.2" />
</startup>
</configuration>
\ No newline at end of file
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment