CATIA VBA-- check if a sketch is having constraints with axis system, and delete such constraints

[AWMM24]

Hi all,
I am trying to make a vba macro which can check if a selected sketch is having constraint with axis system or not, if there is any such constraint I want to delete all such constraints
Please help me in this task.

 

[LWolf]

what is your progress? how far have you gotten--are you stuck on a particular line of your code?

regards,
LWolf

 

[AWMM24]

Hi LWolf,

Well my approach was to get all constraints in sketch and check each constraints constraint element by using GetConstraintElement method in "constraint" Automation API. and check for parents of the constraint element and know the feature to which the constraint element belong to,
but i got stuck here,
say i am checking the contraint elements of a constraint("Offset.180" constraint with "Axis System.1") from sketch
Sketch.1.
i am able to get the constraint elements of constraint Offset.180, one element from sketch.1 and another element from "Axis System.1" and i am trying to see the parents recursively of these two elements, but for both elements i an getting parent as sketch.1 instead of sketch.1 for one element and Axis System.1 for another element.

Set objConstraint = objSketch2.Constraints.Item("Offset.180")

Set ref1 = objConstraint.GetConstraitnElement(1)
Set ref2 = objConstraint.GetConstraitnElement(2)

// here ref1 is element from sketch.1 and ref2 is element from Axis System.1, But i am getting parent as sketch.1 for both elements

my idea was like, if i am able to see the parent of the ref2 and came to know it is an element form axis system.1 then i will delete that constraint but it didn't happen because i am not getting the feature to which the element belongs to.

this is where i am stuck with.

Help is very much appreciated.

 

[kantoku]

Hi AWMM24.

Because it seemed interesting, I tried it.
Try this.

'vba sample_Remove_ConstraintsWithAxisSystem
'Active documents should only be run on CATPart

Option Explicit

Sub CATMain()
    
    'get Part etc...
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As selection
    Set sel = doc.selection
    
    Dim pt As part
    Set pt = doc.part
    
    'get all sketch
    Dim skts As Collection
    Set skts = getAllSketches(pt, sel)
    
    'get Constraints With AxisSystem
    Dim consts As Collection
    Set consts = getConstraintsWithAxis(skts)

    'count check
    Dim msg As String
    If consts.Count < 1 Then
        msg = "There were no constraints to remove."
        MsgBox msg, vbInformation
        Exit Sub
    End If
    
    'query
    msg = "Remove the " & consts.Count & _
        " constraints." & vbCrLf & " Is it OK?"
    
    If MsgBox(msg, vbOKCancel + vbQuestion) = vbCancel Then
        Exit Sub
    End If
    
    'exec remove
    Call removeConstraints(consts, sel)
    
    'fin
    pt.Update
    MsgBox "Done"
    
End Sub

Private Sub removeConstraints( _
    ByVal cons As Collection, _
    ByVal sel As selection)
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    
    Dim con As Constraint
    For Each con In cons
        sel.Add con
    Next
    
    On Error Resume Next
    sel.Delete
    On Error GoTo 0
    
    CATIA.HSOSynchronized = True

End Sub

Private Function getConstraintsWithAxis( _
    ByVal skts As Collection) _
    As Collection
    
    Dim cons As Collection
    Set cons = New Collection
    
    Dim skt As Sketch
    Dim con As Constraint
    Dim i As Long, ref As Reference, geo2D As Geometry2D

    For Each skt In skts
        For Each con In skt.Constraints
            For i = 1 To 3
                On Error Resume Next
                Set ref = con.GetConstraintElement(i)
                On Error GoTo 0
                If ref Is Nothing Then GoTo continue
                
                '+Reference.Parent type is "Geometry2D"
                '+Reference.Parent.GeometricType is "catGeoTypeUnknown"
                'In the case of this condition, it was determined that it was a constraint with AxisSystem.
                Set geo2D = ref.Parent
                If typename(geo2D) = "Geometry2D" And _
                    geo2D.GeometricType = CatGeometricType.catGeoTypeUnknown Then
                
                    cons.Add con
                End If
            Next
continue:
        Next
    Next
    
    Set getConstraintsWithAxis = cons
    
End Function

Private Function getAllSketches( _
    ByVal pt As part, _
    ByVal sel As selection) _
    As Collection
    
    Dim lst As Collection
    Set lst = New Collection
    Set getAllSketches = lst
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    sel.Search "CATPrtSearch.Sketch,all"

    If sel.Count2 < 1 Then Exit Function

    Dim i As Long
    For i = 1 To sel.Count2
        lst.Add sel.Item(i).Value
    Next
    sel.Clear
    
    CATIA.HSOSynchronized = True
    
End Function

 

[AWMM24]

Hi kantoku.

That is nice
i tried the code and yes it is deleting constraints of sketch which are having with axis system.
but the code is also deleting constraint with pad features and sketch feature, i don't want to delete those constraints, is it possible to avoid them deleting.

Please help.

 

[kantoku]

I don't understand English, so I may make a mistake.

Deletion is done in Selection.Delete.

If you do not want to delete it, modify it as follows
Is displayed in a message box.
[Constraint location : Constraint value]

'vba sample_Remove_ConstraintsWithAxisSystem
'Active documents should only be run on CATPart

Option Explicit

Sub CATMain()
    
・・・
    
    'query
'    msg = "Remove the " & consts.Count & _
'        " constraints." & vbCrLf & " Is it OK?"
'
'    If MsgBox(msg, vbOKCancel + vbQuestion) = vbCancel Then
'        Exit Sub
'    End If
    
    'show info
    Call showConstraintInfo(consts)
    
    'exec remove
'    Call removeConstraints(consts, sel)
    
    'fin
'    pt.Update
'    MsgBox "Done"
    
End Sub

Private Sub showConstraintInfo( _
    ByVal cons As Collection)
    
    Dim con As Constraint
    Dim msg As String
    
    For Each con In cons
        msg = msg & con.Dimension.Name & _
             " : " & con.Dimension.Value & vbCrLf
    Next
    
    MsgBox msg

End Sub

・・・

However, the message box has a character limit,
If there are many, not all may be displayed