×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Contact US

*
*
*
*

Thanks. We have received your request and will respond promptly.

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

Macro to look inside a geometrical set and generate a mid point on all the curves.

thread560-506208

Macro to look inside a geometrical set and generate a mid point on all the curves.

Macro to look inside a geometrical set and generate a mid point on all the curves.

(OP)
Hi any help would be great, im trying to generate a mid point on lots of curves/lines in a geometrical set. I want my macro to search inside the geometrical set named "Geom" and loop through generating a mid point on all the curves and lines in that set.

here's my first attempt and it keeps falling over at this stage: "Set hybridBody1 = hybridShapeCircleExplicit1.Item2(1).Value"

CODE --> vb
Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Add()

hybridBody2.Name = "Inspection Points"

Dim hybridShapeBoundary1 As HybridShapeBoundary

Dim InputObjectType(0)
Dim SearchSelection As Selection

Dim reference As reference

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim s As Integer

Dim BoundarySelection1 As Selection
Set BoundarySelection1 = partDocument1.Selection
BoundarySelection1.Search "Name=Geom"
Set hybridBody1 = hybridShapeCircleExplicit1.Item2(1).Value
BoundarySelection1.Search "CATGmoSearch.hybridShapeCircleExplicit1,sel"

For s = 1 To BoundarySelection1.Count

Dim BoundarySelection2 As Selection
Set BoundarySelection2 = partDocument1.Selection
BoundarySelection2.Search "Name=Geom"
Set hybridBody1 = hybridShapeCircleExplicit1.Item2(1).Value
BoundarySelection2.Search "CATGmoSearch.hybridShapeCircleExplicit1,sel"

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(hybridShapeCircleExplicit1.Item2(s).Value)

Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveFromPercent(reference1, 0.500000, False)


hybridBody1.AppendHybridShape hybridShapePointOnCurve1

part1.InWorkObject = hybridShapePointOnCurve1

part1.Update


Next



End Sub

RE: Macro to look inside a geometrical set and generate a mid point on all the curves.

Hi CAD_ROB.

Create a new PartDocument and try the following sample.

CODE --> vba

'vba

Option Explicit

Sub test()

    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument

    Dim pt As Part
    Set pt = doc.Part

    Dim selection1 As selection
    Set selection1 = doc.selection
    selection1.Clear

    Dim selection2 As selection
    Set selection2 = doc.selection
    selection2.Clear
    
    Dim msg As String
    msg = "[selection1 - " & selection1.count & _
        "] [selection2 - " & selection2.count & "]"

    MsgBox msg

    selection1.Add pt.OriginElements.PlaneXY

    msg = "[selection1 - " & selection1.count & _
        "] [selection2 - " & selection2.count & "]"

    MsgBox msg

End Sub
Create selection1 and selection2 and display the number of selections made.
You will notice that the count for selection2 also changes, even though it was only added to selection1.
Selection refers to a single object even though it is assigned to multiple variables.

RE: Macro to look inside a geometrical set and generate a mid point on all the curves.

I have created a sample that creates a midpoint without using "selection.Search".

CODE --> vba

'vba

Option Explicit

Sub CATMain()

    Dim msg As String
    msg = "Select a GeometrySet with curves to create midpoints / ESC = Cancel"
    
    Dim selElement As SelectedElement
    Set selElement = select_element( _
        msg, _
        Array("HybridBody") _
    )
    If selElement Is Nothing Then Exit Sub

    Call create_mid_points_from_geoSet( _
        selElement.value, _
        "Inspection Points" _
    )
    
    MsgBox "Done"

End Sub


Private Function create_mid_points_from_geoSet( _
    ByVal targetHBody As HybridBody, _
    ByVal name As String) _
    As HybridBody

    Set create_mid_points_from_geoSet = Nothing

    Dim targetCurves As Collection
    Set targetCurves = get_curves(targetHBody)
    If targetCurves.count < 1 Then
        Exit Function
    End If

    Dim pt As Part
    Set pt = get_parent_of_T(targetHBody, "Part")
    
    Dim resultHBody As HybridBody
    Set resultHBody = pt.HybridBodies.Add()
    resultHBody.name = name

    Dim crv As AnyObject
    For Each crv In targetCurves
        create_mid_point_by_curve crv, resultHBody
    Next

    pt.UpdateObject resultHBody

End Function


Private Sub create_mid_point_by_curve( _
    ByVal crv As AnyObject, _
    ByRef hBody As HybridBody)

    Dim pt As Part
    Set pt = get_parent_of_T(crv, "Part")

    Dim ref As reference
    Set ref = pt.CreateReferenceFromObject(crv)

    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory

    Dim pnt As HybridShapePointOnCurve
    Set pnt = fact.AddNewPointOnCurveFromPercent( _
        ref, _
        0.5, _
        False _
    )

    hBody.AppendHybridShape pnt

End Sub


Private Function get_curves( _
    ByVal hBody As HybridBody) _
    As Collection

    Dim pt As Part
    Set pt = get_parent_of_T(hBody, "Part")

    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory

    Dim crvs As Collection
    Set crvs = New Collection

    Dim shape As HybridShape
    Dim geoType As Long
    For Each shape In hBody.HybridShapes
        If fact.GetGeometricalFeatureType(shape) = 2 Then
            crvs.Add shape
        End If
    Next
    
    Set get_curves = crvs
    
End Function


Private Function get_parent_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 get_parent_of_T = Nothing
        Exit Function
    End If
    If TypeName(aoj) = t Then
        Set get_parent_of_T = aoj
    Else
        Set get_parent_of_T = get_parent_of_T(aoj.Parent, t)
    End If

End Function


Private Function select_element( _
    ByVal msg As String, _
    ByVal filter As Variant _
    ) As SelectedElement
    
    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 select_element = sel.Item(1)
    sel.Clear

End Function

RE: Macro to look inside a geometrical set and generate a mid point on all the curves.

(OP)
Hi Kantoku, Thanks for your reply.

When running the sample it runs through the mesg box, I select the geoset with the lines/circles in it and nothing happens. The msg box appears then wanting you to select done. Is this because it doesnt recognise the lines/circles as curves? This is when running through as VB script.

when running as a Catscript macro it errors on this line. "Set crvs = New Collection"

Just trying to understand the build up of this vb code.

RE: Macro to look inside a geometrical set and generate a mid point on all the curves.

CAD_ROB.

I have never worked on CatScript, so I did not know the difference between VBA and CatScript.
・Collection is not available
・Return value of HybridShapeFactory.GetGeometricalFeatureType method is off by one.

CODE --> CatScript

'catscript

Option Explicit

Sub CATMain()

    Dim msg As String
    msg = "Select a GeometrySet with curves to create midpoints / ESC = Cancel"
    
    Dim selElement As SelectedElement
    Set selElement = select_element( _
        msg, _
        Array("HybridBody") _
    )
    If selElement Is Nothing Then Exit Sub

    Call create_mid_points_from_geoSet( _
        selElement.value, _
        "Inspection Points" _
    )
    
    get_curves selElement.value
    
    MsgBox "Done"

End Sub


Private Function create_mid_points_from_geoSet( _
    ByVal targetHBody As HybridBody, _
    ByVal name As String) _
    As HybridBody

    Set create_mid_points_from_geoSet = Nothing

    Dim targetCurves As Variant
    targetCurves = get_curves(targetHBody)
    If UBound(targetCurves) < 1 Then
        Exit Function
    End If

    Dim pt As Part
    Set pt = get_parent_of_T(targetHBody, "Part")
    
    Dim resultHBody As HybridBody
    Set resultHBody = pt.HybridBodies.Add()
    resultHBody.name = name

    Dim crv As AnyObject
    For Each crv In targetCurves
        create_mid_point_by_curve crv, resultHBody
    Next

    pt.UpdateObject resultHBody

End Function


Private Sub create_mid_point_by_curve( _
    ByVal crv As AnyObject, _
    ByRef hBody As HybridBody)

    Dim pt As Part
    Set pt = get_parent_of_T(crv, "Part")

    Dim ref As Reference
    Set ref = pt.CreateReferenceFromObject(crv)

    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory

    Dim pnt As HybridShapePointOnCurve
    Set pnt = fact.AddNewPointOnCurveFromPercent( _
        ref, _
        0.5, _
        False _
    )

    hBody.AppendHybridShape pnt

End Sub


Private Function get_curves( _
    ByVal hBody As HybridBody) _
    As Variant

    Dim pt As Part
    Set pt = get_parent_of_T(hBody, "Part")

    Dim fact As HybridShapeFactory
    Set fact = pt.HybridShapeFactory

    Dim crvs() As Variant
    ReDim crvs(hBody.HybridShapes.count)
    Dim count As Long
    count = -1

    Dim shape As HybridShape
    Dim geoType As Long
    Dim i As Long
    For i = 1 To hBody.HybridShapes.count
        Set shape = hBody.HybridShapes.Item(i)
        If fact.GetGeometricalFeatureType(shape) = 3 Then
            count = count + 1
            Set crvs(count) = shape
        End If
    Next
    ReDim Preserve crvs(count)
    get_curves = crvs
    
End Function


Private Function get_parent_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 get_parent_of_T = Nothing
        Exit Function
    End If
    If TypeName(aoj) = t Then
        Set get_parent_of_T = aoj
    Else
        Set get_parent_of_T = get_parent_of_T(aoj.Parent, t)
    End If

End Function


Private Function select_element( _
    ByVal msg As String, _
    ByVal filter As Variant _
    ) As SelectedElement
    
    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 select_element = sel.Item(1)
    sel.Clear

End Function

CatScript is difficult to debug and difficult to develop, so I will not work on it in the future.

RE: Macro to look inside a geometrical set and generate a mid point on all the curves.

(OP)
Hi Kantoku,

It works great recognising the lines and generating the midpoints but doesn't seem to recognise curves or circle geometry and thus doesn't create a mid point on those.

Ive tried debugging the code and it errors at " For Each crv In targetCurves" is this a catscript unable to read error?

TIA

RE: Macro to look inside a geometrical set and generate a mid point on all the curves.

circles, lines and curves should be considered in the get_curves function... so, inside the get_curves add the other two types of curves (3 and 4)

CODE --> 

For Each shape In hBody.HybridShapes
        If fact.GetGeometricalFeatureType(shape) = 2 Or fact.GetGeometricalFeatureType(shape) = 3 Or fact.GetGeometricalFeatureType(shape) = 4 Then
            crvs.Add shape
        End If
    Next

regards,
LWolf

RE: Macro to look inside a geometrical set and generate a mid point on all the curves.

(OP)
Thanks Kantoku and LWolf works a treat. bigsmile

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

Low-Volume Rapid Injection Molding With 3D Printed Molds
Learn methods and guidelines for using stereolithography (SLA) 3D printed molds in the injection molding process to lower costs and lead time. Discover how this hybrid manufacturing process enables on-demand mold fabrication to quickly produce small batches of thermoplastic parts. Download Now
Design for Additive Manufacturing (DfAM)
Examine how the principles of DfAM upend many of the long-standing rules around manufacturability - allowing engineers and designers to place a part’s function at the center of their design considerations. Download Now
Taking Control of Engineering Documents
This ebook covers tips for creating and managing workflows, security best practices and protection of intellectual property, Cloud vs. on-premise software solutions, CAD file management, compliance, and more. 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