Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations cowski on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy & Paste published elements in context 2

Status
Not open for further replies.
mrawlinc

mrawlinc

Industrial
Joined
Nov 19, 2012
Messages
36
Location
SI
I have one level assembly with multiple parts and their instances on different positions. Parts already have published elements (lines and axis systems) that are needed to be copied in (empty) part called "Positions" which is in the in same assembly, so the position of copied elements doesn't change, and also their name should be same as in source part.
I have very very basic skills on programming, so I searched for a similar macro, but couldn't find it ... does anyone have something similar that I could use for a start?
 
Sort by date Sort by votes
newpart is a product type, you cannot paste geometry on a product part, you need to have the paste target inside newpart.

newPart is the instance (Product)
newPart.ReferenceProduct is the reference product of the instance (Product)
newPart.ReferenceProduct.Parent is the document supporting the reference product (PartDocument)
newPart.ReferenceProduct.Parent.Part is the part of the document (Part)

inside this part you can create a geometricalSet if you want:

Code: 
Dim targetpart As Part
Set targetpart = newPart.ReferenceProduct.Parent.Part

Dim geomSetTarget As HybridBody
Set geomSetTarget = targetpart.HybridBodies.Add
geomSetTarget.Name = "Scripted External Reference"

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
So here is code, which copies all published elements from visible parts and their instances in assembly, creates new part, in this case called "Positions", and pastes elements in it. For now it works only with one level assembly.

Special thanks to itsmyjob for guidance&help!

Code: 
Sub CATMain()
    Dim rootProduct As Product
    Set rootProduct = CATIA.ActiveDocument.Product
    
    If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then     'product/part check
        MsgBox rootProduct.Name & " Is NOT Assembly!"
    Exit Sub
    End If
    
    'Debug.Print rootProduct.Name & " Is Product!"
    
    Dim PartsCount As Integer
    PartsCount = rootProduct.Products.Count     'count of parts and instances to use
        
    Dim newPart As Product
    Set newPart = rootProduct.Products.AddNewComponent("Part", "Positions") 'create part paste in it
    
    Dim targetPart As Part
    Set targetPart = newPart.ReferenceProduct.Parent.Part

    Dim geomSetTarget As HybridBody
    Set geomSetTarget = targetPart.HybridBodies.Add
    geomSetTarget.Name = "CopyOfReferences"

    Dim vp As VisPropertySet
        
    For i = 1 To PartsCount
        Set instance = rootProduct.Products.Item(i)
        If isVisible(instance) Then                         'hide/show check to copy only visible parts
            
            Dim publCount As Integer
            publCount = rootProduct.Products.Item(i).Publications.Count
            
            Dim selectedEL As Selection
            Set selectedEL = CATIA.ActiveDocument.Selection
            selectedEL.Clear
                                    
            For j = 1 To publCount
                Set publishedEL = rootProduct.Products.Item(i).Publications.Item(j)
                selectedEL.Add publishedEL
                'Debug.Print (rootProduct.Products.Item(i).Publications.Item(j).Name & " published element is added to selection")
                'Debug.Print newPart.Name
                selectedEL.Copy
                selectedEL.Clear
                selectedEL.Add targetPart
                'selectedEL.PasteSpecial ("CATPrtResultWithOutLink")            'paste as result WITHOUT link
                selectedEL.PasteSpecial ("CATPrtResult")                        'paste as result WITH link
                selectedEL.Clear
            Next
        Else
            'Debug.Print (instance.Name & " is NOT visible")
        End If
    Next
    newPart.Update
End Sub

Function isVisible(ByRef object As Variant) As Boolean      'function for cecking hide/show of part
    CATIA.ActiveDocument.Selection.Clear
    CATIA.ActiveDocument.Selection.Add object
    
    Dim vp As VisPropertySet
    Dim showstate As CatVisPropertyStatus
    Set vp = CATIA.ActiveDocument.Selection.VisProperties
    vp.GetShow showstate
    
    result = True
    
    If showstate = catVisPropertyNoShowAttr Then result = False
    
    CATIA.ActiveDocument.Selection.Clear
    
    isVisible = result
End Function
 
Upvote 0 Downvote
[thumbsup2]

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
Now I can share this valuable [link ]link[/url].

But I'm glad you stayed here with me and learned & share your result.

Just few more things:

you did comment your code, but not enough... please give more info while commenting. Check CATScript in v5automation.chm

if you want to work with multi level product you need to learn about Recursion.

Eric N.
indocti discant et ament meminisse periti ​
 
Upvote 0 Downvote
I'm expanding this macro to retrieve some numbers (position, angle,...) from elements which are copied As result with link, so planes and lines are automatically pasted in External References. Now I'm trying to access them trough HybridBodies, but cant figure out under which collection are they ...

Here is my code:
Code: 
Sub CATMain()
    Dim rootProduct As Product
    Set rootProduct = CATIA.ActiveDocument.Product
    
    'first check if document is part or product
    If InStr(CATIA.ActiveDocument.Name, ".CATProduct") < 1 Then
        MsgBox rootProduct.Name & " Is NOT Assembly!"
    Exit Sub
    End If

    Dim PartsCount As Integer
    PartsCount = rootProduct.Products.Count     'count of parts and instances to use
        
    'Enter name od new Part
    Dim newPartName As String
    newPartName = InputBox("Please enter new Part name.")
        
    Dim newPart As Product
    Set newPart = rootProduct.Products.AddNewComponent("Part", newPartName) 'create part paste in it
    
    Dim targetPart As Part
    Set targetPart = newPart.ReferenceProduct.Parent.Part

    'create Geometical set in new part
    'Dim geomSetTarget As HybridBody
    'Set geomSetTarget = targetPart.HybridBodies.Add
    'geomSetTarget.Name = "CopyOfReferences"

    Dim vp As VisPropertySet
        
    'loop trough parts
    For i = 1 To PartsCount
        Set instance = rootProduct.Products.Item(i)
        
        'check if part is visible, so it takes only visible parts
        If isVisible(instance) Then
            
            'count published elements which will be copied
            Dim publCount As Integer
            publCount = rootProduct.Products.Item(i).Publications.Count
            
            Dim selectedEL As Selection
            Set selectedEL = CATIA.ActiveDocument.Selection
            selectedEL.Clear
                                    
            'loop trough published elements in every part
            For j = 1 To publCount
                Set publishedEL = rootProduct.Products.Item(i).Publications.Item(j)
                selectedEL.Add publishedEL
                selectedEL.Copy
                selectedEL.Clear
                selectedEL.Add targetPart
                
                'uncomment if paste WITHOUT link
                'selectedEL.PasteSpecial ("CATPrtResultWithOutLink")
                
                'paste elements WITH link
                selectedEL.PasteSpecial ("CATPrtResult")
                selectedEL.Clear
            Next
        Else
            'Debug.Print (instance.Name & " is NOT visible")
        End If
    Next
    newPart.Update
'--------------------------------------------------------------------------------------
'Section for retreiving positions and rotation angle fo elements

    Dim axisCount As Integer
    Dim LinesCount As Integer
    Dim Xaxis1 As Double
    Dim Xaxis2 As Double
    
    
    LinesCount = targetPart.HybridBodies.HybridBody.Item(1).GeometricElements.Count
    Debug.Print LinesCount
    
    
    'counting axissystems in new part
    axisCount = targetPart.AxisSystems.Count

        'Loop trough axissystems to retreive components
        For i = 1 To axisCount
            Set ASys = targetPart.AxisSystems.Item(i)
            Set Oref = targetPart.CreateReferenceFromObject(ASys)
            Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
            Set TheMeasurable = TheSPAWorkbench.GetMeasurable(Oref)
            
            Dim Components(11)
            TheMeasurable.GetAxisSystem Components
            
            Components(0) = Round(Components(0), 3)
            Components(1) = Round(Components(1), 3)
            Components(2) = Round(Components(2), 3)
            Components(3) = Round(Components(3), 4)
            Components(6) = Round(Components(6), 4)
    
        Debug.Print targetPart.AxisSystems.Item(i).Name & " x "; Components(0) & " y "; Components(1) & " z"; Components(2)
        

        Xaxis1 = Components(3)
        Xaxis2 = Components(6)
        
            If (Xaxis1 = 1) And (Xaxis2 = 0) Then           'Parallel to X
                Debug.Print "Parallel to X"
            ElseIf (Xaxis1 = -1) And (Xaxis2 = 0) Then      'Parallel to X 180° rotated
                Debug.Print "Parallel to X 180° rotated"
            ElseIf (Xaxis1 = 0) And (Xaxis2 = -1) Then      '+90° rotarted
                Debug.Print "+90° rotarted"
            ElseIf (Xaxis1 = 0) And (Xaxis2 = 1) Then       '-90° rotarted
                Debug.Print "-90° rotarted"
            ElseIf (Xaxis1 > 0) And (Xaxis2 < 0) Then       'First quadrant
                Debug.Print "First quadrant"
            ElseIf (Xaxis1 < 0) And (Xaxis2 < 0) Then       'Second quadrant
                Debug.Print "Second quadrant"
            ElseIf (Xaxis1 < 0) And (Xaxis2 > 0) Then       'Third quadrant
                Debug.Print "Third quadrant"
            ElseIf (Xaxis1 > 0) And (Xaxis2 > 0) Then       'Fourth quadrant
                Debug.Print "Fourth quadrant"
            
            End If
        Next

End Sub

Function isVisible(ByRef object As Variant) As Boolean      'function for cecking hide/show of part
    CATIA.ActiveDocument.Selection.Clear
    CATIA.ActiveDocument.Selection.Add object
    
    Dim vp As VisPropertySet
    Dim showstate As CatVisPropertyStatus
    Set vp = CATIA.ActiveDocument.Selection.VisProperties
    vp.GetShow showstate
    
    result = True
    
    If showstate = catVisPropertyNoShowAttr Then result = False
    
    CATIA.ActiveDocument.Selection.Clear
    
    isVisible = result
End Function
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Y
  • Locked
  • Question Question
About copy - paste special - copy with link in product
Replies
3
Views
2K
yamaCad
Y
Y
  • Locked
  • Question Question
Copy bodies from selected part bodies in product
Replies
4
Views
3K
yamaCad
Y
O
  • Locked
  • Question Question
Abaqus2024 - Duplicate elements in model
Replies
0
Views
764
Old_Ironfighter
O
reutov_tv
  • Locked
  • Question Question
Copy-paste with link --&gt; Thread not detected on drawing
Replies
0
Views
297
reutov_tv
reutov_tv
Ardilla07
  • Locked
  • Question Question
CATIA Copy &amp; Paste Error
Replies
0
Views
625
Ardilla07
Ardilla07

Part and Inventory Search

Sponsor

Back
Top