Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
'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
'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
・・・