vba - CATIA-MACRO EdgeFillet - Stack Overflow

admin管理员组

文章数量:1356135

is there any possibility that a macro can generate Edge fillet after remove operation ( only for holes removed ) . I tried a lot using AI coding , but I didn't get any solution . the only thing that I did is recording a Macro . (but this macro use a specific edges and names) which will not works for different parts or operation names .

    Sub CATMain()

Dim partDocument1 As partDocument
Set partDocument1 = CATIA.activeDocument

Dim part1 As part
Set part1 = partDocument1.part

Dim shapeFactory1 As ShapeFactory
Set shapeFactory1 = part1.ShapeFactory

Dim reference1 As reference
Set reference1 = part1.CreateReferenceFromName("")

Dim constRadEdgeFillet1 As ConstRadEdgeFillet
Set constRadEdgeFillet1 = shapeFactory1.AddNewSolidEdgeFilletWithConstantRadius(reference1, catTangencyFilletEdgePropagation, 3#)

Dim bodies1 As bodies
Set bodies1 = part1.bodies

Dim body1 As body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim remove1 As Remove
Set remove1 = shapes1.Item("Remove.1")

Dim reference2 As reference
Set reference2 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.6;%21);None:();Cf11:());Face:(Brp:(Solid.5;%2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference2

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference3 As reference
Set reference3 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.6;%18);None:();Cf11:());Face:(Brp:(Solid.5;%2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference3

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference4 As reference
Set reference4 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.5;%3);None:();Cf11:());Face:(Brp:(Solid.6;%24);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference4

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference5 As reference
Set reference5 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.5;%3);None:();Cf11:());Face:(Brp:(Solid.6;%27);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference5

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

part1.UpdateObject constRadEdgeFillet1

part1.Update

End Sub

enter image description here

is there any possibility that a macro can generate Edge fillet after remove operation ( only for holes removed ) . I tried a lot using AI coding , but I didn't get any solution . the only thing that I did is recording a Macro . (but this macro use a specific edges and names) which will not works for different parts or operation names .

    Sub CATMain()

Dim partDocument1 As partDocument
Set partDocument1 = CATIA.activeDocument

Dim part1 As part
Set part1 = partDocument1.part

Dim shapeFactory1 As ShapeFactory
Set shapeFactory1 = part1.ShapeFactory

Dim reference1 As reference
Set reference1 = part1.CreateReferenceFromName("")

Dim constRadEdgeFillet1 As ConstRadEdgeFillet
Set constRadEdgeFillet1 = shapeFactory1.AddNewSolidEdgeFilletWithConstantRadius(reference1, catTangencyFilletEdgePropagation, 3#)

Dim bodies1 As bodies
Set bodies1 = part1.bodies

Dim body1 As body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim remove1 As Remove
Set remove1 = shapes1.Item("Remove.1")

Dim reference2 As reference
Set reference2 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.6;%21);None:();Cf11:());Face:(Brp:(Solid.5;%2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference2

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference3 As reference
Set reference3 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.6;%18);None:();Cf11:());Face:(Brp:(Solid.5;%2);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference3

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference4 As reference
Set reference4 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.5;%3);None:();Cf11:());Face:(Brp:(Solid.6;%24);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference4

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

Dim reference5 As reference
Set reference5 = part1.CreateReferenceFromBRepName("TgtIntersEdge:(GeneratedEdges;MfIE_R20SP4HFAA;TgtPropagationFillet;FirstOperands:(Remove.1);SecondOperands:();InitEdges:(REdge:(Edge:(Face:(Brp:(Solid.5;%3);None:();Cf11:());Face:(Brp:(Solid.6;%27);None:();Cf11:());None:(Limits1:();Limits2:());Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)))", remove1)

constRadEdgeFillet1.AddObjectToFillet reference5

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

part1.UpdateObject constRadEdgeFillet1

part1.Update

End Sub

enter image description here

• vba
• catia

Share Improve this question Follow edited Mar 28 at 8:18 FunThomas 30k44 gold badges2323 silver badges3838 bronze badges asked Mar 28 at 7:57 New User With youNew User With you 1955 bronze badges

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 1

You can get the edges using selection -> search, by selecting the boolean operation and search in the selected element for the edges.

Here an example:

Sub CATMain()

Dim oPartDoc As Document
Dim oSel As Selection
Dim oPart as Part
Dim oMainBody as Body
Dim oRemove As Shape
Dim oShapeFactory As Factory
Dim oFillet As ConstRadEdgeFillet
Dim i as Long

Set oPartDoc = CATIA.ActiveDocument
Set oSel = oPartDoc.Selection
Set oPart = oPartDoc.Part
Set oMainBody = oPart.Mainbody
Set oShapeFactory = oPart.ShapeFactory

'select boolean operation and search for edges
Set oRemove = oMainBody.Shapes.Item("Remove.1")
oSel.Clear
oSel.Add oRemove

oSel.Search "Topology.CGMEdge,sel"

'create fillet and add selected edges
If oSel.Count2 <> 0 Then
    Set oFillet = oShapeFactory.AddNewSolidEdgeFilletWithConstantRadius(nothing, catTangencyFilletEdgePropagation, 5.000000)

    For i = 1 to oSel.Count2
        oFillet.AddObjectToFillet oSel.Item2(i).Value  'or .Reference
    Next
    
    oPart.Update 

End If

End Sub

BTW: This can be done manually using the propagation mode "intersect" in the fillet function without selecting edges.

本文标签： vbaCATIAMACRO EdgeFilletStack Overflow