-
1
- #1
Manuel Pimenta
Mechanical
Hi everyone,
I have been working on a macro that does basically the same as the CATIA command Generate CATPart from Product, except it keeps the original colours of the bodies and geometrical elements.
The colors of the bodies, especially the ones assigned to individual faces, is very important to the workflow of my company, since we use different colours to indicate different types of finishing quality.
The code is part reused from similar macros I found here and part made by me.
I should give credits to a lot of people from here, but I didn't take note of everyone.
Right now the macro works well, but i still have a few problems to deal with.
I'm posting here to ask for your help with one of them.
So the problem is: when copying bodies from parts that have instances, the pasted bodies all end up on one place, instead of landing on the same place as the instance they were copied from.
I tried using publications to overcome this, but i get inconsistent results.
Anyone has a different approach to this problem?
Thanks in advance.
My code so far
I have been working on a macro that does basically the same as the CATIA command Generate CATPart from Product, except it keeps the original colours of the bodies and geometrical elements.
The colors of the bodies, especially the ones assigned to individual faces, is very important to the workflow of my company, since we use different colours to indicate different types of finishing quality.
The code is part reused from similar macros I found here and part made by me.
I should give credits to a lot of people from here, but I didn't take note of everyone.
Right now the macro works well, but i still have a few problems to deal with.
I'm posting here to ask for your help with one of them.
So the problem is: when copying bodies from parts that have instances, the pasted bodies all end up on one place, instead of landing on the same place as the instance they were copied from.
I tried using publications to overcome this, but i get inconsistent results.
Anyone has a different approach to this problem?
Thanks in advance.
My code so far
Code:
' Generate CATPart From Product with colors v0
'Manuel Pimenta 2019/08/17
'This macro runs from the root of the active CATProduct
'What it does:
' Cycle trough all the parts in the tree, checks which ones are visible, and copies the visible bodies and geometrical elements to a new part
' created in the root of the product
' The name of each copied element is it's path in the tree
' After all copies are done, the new part is opened in new window and deleted from the product root
' The funcionality is identical to the CATIA command Generate CATPart From Product, but using the macro keeps the colors assigned to faces of bodies
' and also the visual proprieties of geometrical elements
'''''''''''''''''''''''''''''''''''''''''''''''''''
'Pending issues
'-> dealing with instanciated parts is a problem. In v0 copies of instanciated parts located in different places in the assembly will all be in the same place in the new part.
'A solution may be to publicate all elements to be copied,in order to keep the location of instanciated parts in the assembly.
'This solution was tested (disabled in v0), but the behaviour of the copies with publication is inconsistent, sometimes works, but not everytime.
'Still to be dealt with
'-> add a form in the begginig of macro to allow user to choose the name of the part were the bodies and geometrical elements will be pasted, and also
' give the option to choose copy with link or without link. If copy with link is choosen, the code that opens the new part in new window and deletes it
'from the main product should be jumped
Dim existPubCounter As Integer
Dim finalPubCounter As Integer
Sub CATMain()
Dim rootProduct As Product
Set rootProduct = CATIA.ActiveDocument.Product
'add a new part to the root of the assembly.
'MsgBox rootProduct.Products.Count
Dim newPartProduct As Product
Call Randomize
suffix = Rnd(1) * 10000
Set newPartProduct = rootProduct.Products.AddNewComponent("Part", rootProduct.Name + "_AllCATPart_Colors" + CStr(suffix))
Dim newPart As Part
Set newPart = newPartProduct.ReferenceProduct.Parent.Part
'hide new part origin planes
Call HidePartOriginPlanes(newPart)
'comfirm the new part has been created
'MsgBox rootProduct.Products.Count
Dim subProduct As Product
'now loop though all the child products of the root product.
For i = 1 To rootProduct.Products.Count - 1
Set subProduct = rootProduct.Products.Item(i)
'call the recursive function to copy all visible bodies from subProduct to the new part
Call CopySubProduct(subProduct, newPart)
Next
'now that all bodies have been copied open the new part in a new window and delete it from the rootproduct tree
Dim selection1 As Selection
Set selection1 = CATIA.ActiveDocument.Selection
selection1.Clear
selection1.Add newPartProduct
CATIA.StartCommand "Open in New Window"
selection1.Delete
newPart.Update
End Sub
Sub CopySubProduct(aSubProduct As Product, targetPart As Part)
'MsgBox aSubProduct.Name
'MsgBox isVisible(aSubProduct)
' first check if subproduct is hidden. If hidden, skip it
If isVisible(aSubProduct) = False Then
Debug.Print aSubProduct.Name & " is hidden. No copies will be made"
'MsgBox "esta escondido"
Exit Sub
'if it is the target part itself, then skip it...
ElseIf aSubProduct.ReferenceProduct.Parent.Name = targetPart.Parent.Name Then
Debug.Print "Thats the target part..."
Exit Sub
' if it is a part, make sure the part body is published and then
' copy-paste-special-as-result the part body into the new part
ElseIf InStr(aSubProduct.ReferenceProduct.Parent.Name, ".CATPart") = Len(aSubProduct.ReferenceProduct.Parent.Name) - 7 Then
Debug.Print aSubProduct.Name; " is a Part"
Call CopyPasteBodies(aSubProduct, targetPart)
Call CopyPasteHybridElements(aSubProduct, targetPart)
'MsgBox "é um part"
'if it is a sub assembly recursively call this subroutine on it
ElseIf InStr(aSubProduct.ReferenceProduct.Parent.Name, ".CATProduct") = Len(aSubProduct.ReferenceProduct.Parent.Name) - 10 Then
Debug.Print aSubProduct.Name & " is a Product"
Dim subSubProduct As Product
For i = 1 To aSubProduct.Products.Count
Set subSubProduct = aSubProduct.Products.Item(i)
Call CopySubProduct(subSubProduct, targetPart)
Next
End If
End Sub
Sub CopyPasteBodies(productA As Product, partA As Part)
Dim part1 As Part
Set part1 = productA.ReferenceProduct.Parent.Part
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies
Dim body1 As Body
Dim origBody1Name As String
Dim pastedBody As Body
Dim pastedBodyName As String
Dim selection2 As Selection
Set selection2 = CATIA.ActiveDocument.Selection
selection2.Clear
'Call PublishAllVisibleBodies(productA)
For i = 1 To bodies1.Count
Set body1 = bodies1.Item(i)
If body1.InBooleanOperation = False And isVisible(body1) = True And body1.Shapes.Count > 0 Then
origBody1Name = body1.Name
selection2.Clear
selection2.Add body1
'selection2.Add productA.Publications.Item(i).Valuation
'MsgBox "publicação " + productA.Publications.Item(i).Name + productA.Name
selection2.Copy
selection2.Clear
selection2.Add partA
selection2.PasteSpecial "CATPrtResultWithOutLink"
Set pastedBody = partA.Bodies.Item(partA.Bodies.Count)
pastedBodyName = GetPathFromInstance(productA) + "\" + origBody1Name
pastedBody.Name = pastedBodyName
'MsgBox body1.Name + " body colado"
End If
Next
'sel.Add sourcePartProduct.Publications.Item("PartBody").Valuation
'partA.Update
End Sub
Sub CopyPasteHybridElements(productA As Product, targetPart As Part)
Dim part1 As Part
Set part1 = productA.ReferenceProduct.Parent.Part
Dim HybridBodies1 As HybridBodies
Set HybridBodies1 = part1.HybridBodies
Dim HybridBodies2 As HybridBodies
Set HybridBodies2 = targetPart.HybridBodies
Dim pastedHybridBody As HybridBody
Dim targetPartHBCount As Integer
Dim hybridBody1 As HybridBody
Dim geosetName As String
Dim select1 As Selection
Set select1 = CATIA.ActiveDocument.Selection
'MsgBox HybridBodies1.Count
For i = 1 To HybridBodies1.Count
select1.Clear
Set hybridBody1 = HybridBodies1.Item(i)
If isVisible(hybridBody1) = True Then
select1.Add HybridBodies1.Item(i)
geosetName = select1.Item(1).Value.Name
'MsgBox geosetName
'select2.Search "CATAsmSearch.HybridBodies,scr"
select1.Copy
select1.Clear
select1.Add targetPart
select1.PasteSpecial "CATPrtResultWithOutLink"
select1.Clear
targetPartHBCount = HybridBodies2.Count
Set pastedHybridBody = HybridBodies2.Item(targetPartHBCount)
pastedHybridBody.Name = GetPathFromInstance(productA) + "\" + geosetName
'delete copied elements that are hidden in original part
Dim elemCount As Integer
elemCount = hybridBody1.HybridShapes.Count
Dim ElementVisible As Boolean
For j = elemCount To 1 Step -1
ElementVisible = isVisible(hybridBody1.HybridShapes.Item(j))
If ElementVisible = False Then
MsgBox hybridBody1.HybridShapes.Item(j).Name + " " + CStr(ElementVisible)
select1.Clear
select1.Add pastedHybridBody.HybridShapes.Item(j)
select1.Delete
select1.Clear
End If
Next
End If
Next
End Sub
'
'Sub PublishAllVisibleBodies(aPartProduct As Product)
'
' 'store number of existing publications
' existPubCounter = aPartProduct.Publications.Count
' finalPubCounter = existPubCounter
'
' 'get the part
' Dim thePart As Part
' Set thePart = aPartProduct.ReferenceProduct.Parent.Part
'
' Dim body1 As Body
' Dim numFeatures As Integer
'
'
' For i = 1 To thePart.Bodies.Count
'
' Set body1 = thePart.Bodies.Item(i)
' numFeatures = body1.Shapes.Count + body1.Sketches.Count
'
' 'create publication only for visible bodies and bodies that are not empty
' If isVisible(thePart.Bodies.Item(i)) = True And numFeatures > 0 Then
' finalPubCounter = finalPubCounter + 1
'
' Dim aPub As Publication
'
'
'
' ' first try to get the publication
' On Error Resume Next
' Set aPub = aPartProduct.Publications.Item(thePart.Bodies.Item(i).Name)
' Err.Clear
'
'
'
' 'publish the body
' Dim ref As Reference
' Set ref = aPartProduct.CreateReferenceFromName(aPartProduct.Name & "/!" & thePart.Bodies.Item(1).Name)
'
'
' 'MsgBox thePart.Bodies.Item(i).Name
'
' Set aPub = aPartProduct.Publications.Add(thePart.Bodies.Item(i).Name)
' aPartProduct.Publications.SetDirect thePart.Bodies.Item(i).Name, ref
' End If
' Next
'
'End Sub
Function isVisible(object1 As Object) As Boolean
Dim sel1 As Selection
Set sel1 = CATIA.ActiveDocument.Selection
'MsgBox Product.Name
sel1.Clear
sel1.Add object1
'MsgBox sel1.Item(1).Value.Name
Dim showstate As CatVisPropertyShow
Set visProperties1 = sel1.VisProperties
visProperties1.GetShow showstate
Select Case showstate
Case catVisPropertyNoShowAttr
'MsgBox "Hidden View"
isVisible = False
Case catVisPropertyShowAttr
'MsgBox "visible View"
isVisible = True
End Select
sel1.Clear
End Function
Function GetPathFromInstance(inst As Product, Optional maxLevels As Integer = 100) As String
GetPathFromInstance = ""
Dim parentObj
Set parentObj = inst
Dim levelCnt As Integer
Dim stringToRemove As String
levelCnt = 0
Do While TypeName(parentObj) <> "Application" And levelCnt < maxLevels
If TypeName(parentObj) = "Product" Then
If Len(GetPathFromInstance) > 0 Then
GetPathFromInstance = parentObj.Name & "\" & GetPathFromInstance
stringToRemove = parentObj.Name
Else
GetPathFromInstance = parentObj.Name
End If
End If
Set parentObj = parentObj.Parent
levelCnt = levelCnt + 1
Loop
GetPathFromInstance = Right(GetPathFromInstance, Len(GetPathFromInstance) - Len(stringToRemove) - 1)
Exit Function
End Function
Sub HidePartOriginPlanes(myPart As Part)
Dim OriginElement, myPlaneZX, myPlaneXY, myPlaneYZ
Set OriginElement = myPart.OriginElements
Set myPlaneXY = OriginElement.PlaneXY
Set myPlaneYZ = OriginElement.PlaneYZ
Set myPlaneZX = OriginElement.PlaneZX
Dim RefmyPlaneXY As Reference
Set RefmyPlaneXY = myPart.CreateReferenceFromObject(myPlaneXY)
Dim RefmyPlaneYZ As Reference
Set RefmyPlaneYZ = myPart.CreateReferenceFromObject(myPlaneYZ)
Dim RefmyPlaneZX As Reference
Set RefmyPlaneZX = myPart.CreateReferenceFromObject(myPlaneZX)
Dim HS As HybridShapeFactory
Set HS = myPart.HybridShapeFactory
HS.GSMVisibility RefmyPlaneXY, 0
HS.GSMVisibility RefmyPlaneYZ, 0
HS.GSMVisibility RefmyPlaneZX, 0
End Sub