Dear all,
I'm trying to write a code that take a Product and check all its components to verify if they are created using structure Design workbench (SR1). The macro will create a new product, and also will reconstruct the assembly tree as the original.
During this reconstruction, the components created at SR1, should be tranformed into DATUM by a copy paste method As Result. The other ones will just be copied at the same position as the original product.
The mais reason to write this code is the fact of a Standard CATIA V5 instalation, such as only MD2, will not be able to open an assembly created at SR1 workbench. That's the reason to create a DATUM one. The code were developed at V5R16 SP9.
I don't know why, but I'm have a problem if the component is a second Instance of any other.
I'm attaching a my code.
lase, any suggestion to solve my problem ? If anyboy needs the V5 files to test pls emailme that I could provide it. They are very large and I couldn't upload them here.
Regards,
Arthur Zanetti
arthur@lwt.com.br
===============================================================
Dim Nome As String
Nome = ""
Public FirstPart As Part
Public FirstHybridBodies As HybridBodies
Public FirstHybridBody As HybridBody
Public rootProduct As Product
'##############################################################################################
' Main Sub
'##############################################################################################
Sub CATMain()
'##############################################################################################
'Identify the main product and its name
'##############################################################################################
Dim ProductDoc As ProductDocument
Set ProductDoc = CATIA.ActiveDocument
Set rootProduct = ProductDoc.Product
Nome = rootProduct.Name
'##############################################################################################
' Creates a new assembly file base on the actual one
'##############################################################################################
Dim MyDocuments As Documents
Set MyDocuments = CATIA.Documents
Dim NewProduct As Document
Set NewProduct = MyDocuments.Add("Product"
Dim product1 As Product
Set product1 = NewProduct.Product
product1.PartNumber = Nome & " " & Date
Nome = ""
Dim windows1 As Windows
Set windows1 = CATIA.Windows
windows1.Arrange catArrangeTiledHorizontal
Dim specsAndGeomWindow1 As Window
Set specsAndGeomWindow1 = CATIA.ActiveWindow
Dim viewer3D1 As Viewer
Set viewer3D1 = specsAndGeomWindow1.ActiveViewer
viewer3D1.Reframe
Dim viewpoint3D1 As Viewpoint3D
Set viewpoint3D1 = viewer3D1.Viewpoint3D
'##############################################################################################
' Verify all items of the main Product
'##############################################################################################
Dim QtdTotal As Integer
Dim subProduct As Product
QtdTotal = rootProduct.Products.Count
For i = 1 To rootProduct.Products.Count
Set subProduct = rootProduct.Products.Item(i)
'##############################################################################################
' Verifi if the item is a CATPart, in affirmative case starts the copy process
'##############################################################################################
If InStr(SubProduct.ReferenceProduct.Parent.Name, ".CATPart" = Len(SubProduct.ReferenceProduct.Parent.Name) - 7 Then
Call CopyPaste(subProduct, product1, ProductDoc, NewProduct)
Else
End If
product1.Update
viewer3D1.Reframe
Next
rootProduct.Update
End Sub
'##############################################################################################
' Sub to create the copies
'##############################################################################################
Sub CopyPaste(CurrentProduct As Product, bNewProduct As Product, MyDoc As Document, MyNewDoc As Document)
Set sel = MyDoc.Selection
sel.Clear
Set sel2 = MyNewDoc.Selection
sel2.Clear
Dim thePart As Part
Set thePart = CurrentProduct.ReferenceProduct.Parent.Part
'##############################################################################################
'Verify if the Part contains a HybridBody called "STRSKELETON"
'##############################################################################################
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = thePart.HybridBodies
Dim hybridBody1 As HybridBody
On Error Resume Next
Set hybridBody1 = hybridBodies1.Item("StrSkeleton"
If Err.Number <> 0 Then
sel.Clear
sel.Add CurrentProduct
sel.Copy
sel.Clear
sel2.Clear
sel2.Add bNewProduct
sel2.PasteSpecial ("CATProdCont"
Else
'##############################################################################################
'Call the sub that creates a new DATUM Part
'##############################################################################################
Call NewPartResult(CurrentProduct, bNewProduct, MyDoc)
End If
End Sub
'##############################################################################################
' Sub to create the new DATUM Paart
'##############################################################################################
Sub NewPartResult(CurrentProduct_2 As Product, NewProduct_2 As Product, CurrentDoc_2 As Document)
Set sel3 = CurrentDoc_2.Selection
sel3.Clear
Dim ActualPart As Part
Set ActualPart = CurrentProduct_2.ReferenceProduct.Parent.Part
Dim NomePart As String
NomePart = ActualPart.Name
Dim ActualBodies As Bodies
Set ActualBodies = ActualPart.Bodies
Dim ActualBody As Body
Set ActualBody = ActualBodies.Item("PartBody"
sel3.Add ActualBody
sel3.Copy
sel3.Clear
Dim NewProducts As Products
Set NewProducts = NewProduct_2.Products
Dim NewComponent As Product
Set NewComponent = NewProducts.AddNewComponent("Part", NomePart)
Dim MyDocuments As Documents
Set Mydocuments = CATIA.Documents
Dim NewPartDoc As Document
Set NewPartDoc = CATIA.ActiveDocument
Set sel4 = NewPartDoc.Selection
sel4.Clear
Dim NewPart As Part
Set NewPart = NewComponent.ReferenceProduct.Parent.Part
Dim NewBodies As Bodies
Set NewBodies = NewPart.Bodies
Dim NewBody As Body
Set NewBody = NewBodies.Item("PartBody"
NewPart.InWorkObject = NewBody
sel4.Add NewBody
sel4.PasteSpecial ("CATPrtResultWithOutLink"
sel4.Clear
Dim PBody As Body
Set PBody = NewBodies.Item("Body.2"
NewPart.MainBody = PBody
Newpart.Update
sel4.Add NewBody
sel4.Delete
sel4.Clear
Newpart.Update
pBody.Name = "PartBody"
'##############################################################################################
' Correction of the new component position if necessary
'##############################################################################################
Dim PartArray(2) As Double
PartArray(0) = 0.000000
PartArray(1) = 0.000000
PartArray(2) = 0.000000
Dim ProductArray(2) As Double
ProductArray(0) = 0.000000
ProductArray(1) = 0.000000
ProductArray(2) = 0.000000
Call Coord_Transform(PartArray, ProductArray, CurrentProduct_2)
If ProductArray(0) = 0.000000 Then
If ProductArray(1) = 0.000000 Then
If ProductArray(2) = 0.000000 Then Exit Sub
Else
Dim move1 As Move
Set move1 = NewComponent.Move
Set move1 = move1.MovableObject
Dim arrayOfVariantOfDouble1(11)
arrayOfVariantOfDouble1(0) = 1.000000
arrayOfVariantOfDouble1(1) = 0.000000
arrayOfVariantOfDouble1(2) = 0.000000
arrayOfVariantOfDouble1(3) = 0.000000
arrayOfVariantOfDouble1(4) = 1.000000
arrayOfVariantOfDouble1(5) = 0.000000
arrayOfVariantOfDouble1(6) = 0.000000
arrayOfVariantOfDouble1(7) = 0.000000
arrayOfVariantOfDouble1(8) = 1.000000
arrayOfVariantOfDouble1(9) = ProductArray(0)
arrayOfVariantOfDouble1(10) = ProductArray(1)
arrayOfVariantOfDouble1(11) = ProductArray(2)
move1.Apply arrayOfVariantOfDouble1
End If
End If
End Sub
'##############################################################################################
'SUB to compute the origin coordinates of the component base on the Product's origin
'##############################################################################################
Sub Coord_Transform(aRel As Double, aAbs As Double, oProduct As Product)
'Sub Coord_Transform(aRel As Double, aAbs As Double, 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)
'MsgBox aAbs(0) & " " & aAbs(1) & " " & aAbs(2)
End Sub
'##############################################################################################
'Funcao MATRIZ
'##############################################################################################
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
Det3x3 = dX11 * dX22 * dX33 + dX12 * dX23 * dX31 + dX21 * dX32 * dX13 - dX13 * dX22 * dX31 - dX12 * dX21 * dX33 - dX23 * dX32 * dX11
End Function
'##############################################################################################
'Funcao MATRIZ INVERSA
'##############################################################################################
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
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 |