'vba
Option Explicit
Sub CATMain()
' Select Body
Dim msg As String
msg = "select body"
Dim targetBody As body
Set targetBody = SelectItem(msg, Array("Body"))
If targetBody Is Nothing Then Exit Sub
' Get Circle Edge Reference List
Dim circleEdgeRefs As Collection
Set circleEdgeRefs = getEdgeReference(targetBody)
' Execute Fillet
Dim filletSize As Double
filletSize = 5#
Call createFillet(targetBody, circleEdgeRefs, filletSize)
' Finish
MsgBox "Done"
End Sub
Private Sub createFillet( _
ByVal bdy As body, _
ByVal refs As Collection, _
ByVal size As Double)
Dim pt As part
Set pt = GetParent_Of_T(bdy, "Part")
Dim fact As ShapeFactory
Set fact = pt.ShapeFactory
Dim prop As Long
prop = catTangencyFilletEdgePropagation
Dim flt As ConstRadEdgeFillet
Dim ref As Reference
Set ref = refs.Item(1)
Set flt = fact.AddNewSolidEdgeFilletWithConstantRadius( _
ref, prop, size)
If refs.Count < 2 Then
GoTo finish
End If
Dim i As Long
For i = 2 To refs.Count
Set ref = refs.Item(i)
flt.AddObjectToFillet ref
Next
finish:
pt.UpdateObject flt
End Sub
Private Function getEdgeReference( _
ByVal bdy As body) As Collection
Dim lst As Collection
Set lst = New Collection
Dim shp As shape
Set shp = bdy.Shapes.Item(bdy.Shapes.Count)
Dim sel As selection
Set sel = CATIA.ActiveDocument.selection
CATIA.HSOSynchronized = False
sel.Clear
sel.Add bdy
sel.Search "Topology.CGMEdge,sel"
If sel.Count2 < 1 Then
GoTo finish
End If
Dim pt As part
Set pt = GetParent_Of_T(bdy, "Part")
pt.InWorkObject = shp
Dim fact As HybridShapeFactory
Set fact = pt.HybridShapeFactory
Dim ref As Reference
Dim bRepName As String
Dim i As Long
For i = 1 To sel.Count2
bRepName = getBrepName(sel.Item2(i).Value.Name)
Set ref = pt.CreateReferenceFromBRepName(bRepName, shp)
If fact.GetGeometricalFeatureType(ref) = 4 Then
lst.Add ref
End If
Next
sel.Clear
CATIA.HSOSynchronized = True
finish:
Set getEdgeReference = lst
End Function
Private Function GetParent_Of_T( _
ByVal aoj As AnyObject, _
ByVal T As String) _
As AnyObject
Dim aojName As String
Dim parentName As String
On Error Resume Next
aojName = aoj.Name
parentName = aoj.Parent.Name
On Error GoTo 0
If typename(aoj) = typename(aoj.Parent) And _
aojName = parentName Then
Set GetParent_Of_T = Nothing
Exit Function
End If
If typename(aoj) = T Then
Set GetParent_Of_T = aoj
Else
Set GetParent_Of_T = GetParent_Of_T(aoj.Parent, T)
End If
End Function
Private Function getBrepName( _
selectName As String) As String
Dim tmp As String
tmp = Replace(selectName, "Selection_", "")
tmp = Left(tmp, InStrRev(tmp, "));"))
tmp = tmp & ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
getBrepName = tmp
End Function
Private Function SelectItem( _
ByVal msg$, _
ByVal filter As Variant) _
As AnyObject
Dim sel As Variant
Set sel = CATIA.ActiveDocument.selection
sel.Clear
Select Case sel.SelectElement2(filter, msg, False)
Case "Cancel", "Undo", "Redo"
Exit Function
End Select
Set SelectItem = sel.Item(1).Value
sel.Clear
End Function