×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBA- Create edge fillet failing

VBA- Create edge fillet failing

VBA- Create edge fillet failing

(OP)
I have an issue with creating edge fillets

Goal is to create fillet on sharp edges on a join surface. The join surface has several hundred faces and shapr edges.

Script fails at -----

shapeFactory1.AddNewSurfaceEdgeFilletWithConstantRadius(bumpsref(1), catTangencyFilletEdgePropagation, 0.2)
Could one of you help me out. Thank you..




here is my script

-------------------------------------------------------------------------

Sub CATMain()

Dim partDocument1 As PartDocument

Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part

Set part1 = partDocument1.Part

Dim selectionbody As selection

Set selectionbody = partDocument1.selection

selectionbody.Clear

Dim InputObject(0)

InputObject(0) = "HybridShape"



Set Bodyforfillet = CATIA.ActiveDocument.selection

MsgBox "Select Surafece wih bumps"

Status = Bodyforfillet.SelectElement2(InputObject, "Select Surface for fillets", False) 'Selection

Set bodyname = selectionbody.Item(1).Value

MsgBox bodyname.Name

'-------------------------------------------

Dim Bodyslection As selection

Set Bodyslection = CATIA.ActiveDocument.selection

Bodyslection.Search "type=topology.face,sel"

MsgBox Bodyslection.Count2

MsgBox Bodyslection.Item(2).Name

'selectionbody.Clear

Dim bumps As Integer

bumps = Bodyslection.Count2

Dim bumpsref() As Reference

ReDim bumpsref(1 To bumps)

For i = 1 To bumps

Set bumpsref(i) = Bodyslection.Item(i).Reference

'MsgBox bumpsref(i).Name

'Dim oface As Face

'Set oface = Bodyslection.Item(i).Value

'Dim Pillow_ref As Reference

'Set Pillow_ref = part1.CreateReferenceFromBRepName(bumpsref(i).Name, oface.Parent)

Next

Bodyslection.Clear

'-------------------------------------- Adding fillets

Dim shapeFactory1 As ShapeFactory

Set shapeFactory1 = part1.ShapeFactory

Dim constRadEdgeFillet1 As ConstRadEdgeFillet

Set constRadEdgeFillet1 = shapeFactory1.AddNewSurfaceEdgeFilletWithConstantRadius(bumpsref(1), catTangencyFilletEdgePropagation, 0.2)

For i = 2 To bumps

constRadEdgeFillet1.AddObjectToFillet bumpsref(i)

Next

constRadEdgeFillet1.FilletBoundaryRelimitation = 1

constRadEdgeFillet1.EdgePropagation = catTangencyFilletEdgePropagation

constRadEdgeFillet1.FilletBoundaryRelimitation = catConnectFilletBoundaryRelimitation

constRadEdgeFillet1.FilletTrimSupport = catTrimFilletSupport

End Sub

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login


Resources

eBook - The Future of Product Development is Here
Looking to make the design and manufacturing of your products more agile? For engineering and manufacturing organizations, the need for digital transformation of product development processes just became more urgent than ever so we wanted to share an eBook that will help you build a practical roadmap for your journey. Download Now

Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close