Continue to Site

Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations KootK on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Collect only vertical edges

Status
Not open for further replies.

NaWin55

Mechanical
Mar 21, 2020
97
Hello all

i need to collect only vertical edges from surfaces like this (below image)
Capture_j6uyjt.jpg


i tried one method it worked like 60% but i need to collect only vertical edges regardless of any axis orientation

Thanks
 
Replies continue below

Recommended for you

@itsmyjob, that was exactly my question in the first place... [ponder]vertical/horizontal in reference to what?...

regards,
LWolf
 
Hello all

i am sharing a reference cad model, what i m working on is trying to creating blend between surfaces using a macro

user will select a all the surfaces required for blend and code will look for correct blending edges and blend will be created

for this i am trying to extract only vertical edges but that will be difficult because axis orientation may change or edges angle may change

i tried calculating the distances between lines which one gives the smallest those lines will close together and can be used for blend but that might not work al the time

is there any other way


Blend_Surfaces_vetgz5.jpg


Blend_g6icgy.jpg


my goal is here to create blend using a macro
 
NaWin55.

Thanks for the data.
Do I just get the edges that are not always parallel to the Y-axis in sequence?
 
NaWin55.

Run the following macro, select Yaxis and then GeometricSet.
You should be able to find the edge you are looking for.
1_ck3dcv.png


Code:
'vba

Option Explicit

Private Const TOLERANCE = 0.001

Sub CATMain()

    Dim partDoc As PartDocument
    Set partDoc = CATIA.ActiveDocument

    Dim msg As String
    msg = "Please select a reference edge or line : ESC key Exit"

    Dim filter As Variant
    filter = Array( _
        "RectilinearTriDimFeatEdge", _
        "RectilinearBiDimFeatEdge", _
        "RectilinearMonoDimFeatEdge" _
    )

    Dim baseLineRef As Reference
    Set baseLineRef = select_item_reference(msg, filter)
    If baseLineRef Is Nothing Then Exit Sub


    msg = "Please select a geometric set to find perpendicular edges : ESC key Exit"
    filter = Array("HybridBody")

    Dim hBody As HybridBody
    Set hBody = select_item(msg, filter)
    If hBody Is Nothing Then Exit Sub

    Dim edges As Collection
    Set edges = get_perpendicular_edges(baseLineRef, hBody)

    Dim sel As Selection
    Set sel = partDoc.Selection
    sel.Clear
    
    Dim edge As Reference
    For Each edge In edges
        sel.Add edge
    Next

    MsgBox "Done"

End Sub


Private Function get_perpendicular_edges( _
    ByVal baseLineRef As Reference, _
    ByVal hBody As HybridBody _
    ) As Collection

    Dim edges As Collection
    Set edges = get_edges(hBody)

    If edges.count < 1 Then
        Set get_perpendicular_edges = edges
        Exit Function
    End If

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

    Dim meas As Measurable
    Set meas = get_measurable( _
        pt, _
        baseLineRef _
    )

    Dim perpendicularEdges As Collection
    Set perpendicularEdges = New Collection

    Dim edge As Reference
    For Each edge In edges
        On Error Resume Next
        
        If Abs(meas.GetAngleBetween(edge) - 90) < TOLERANCE Then
            perpendicularEdges.Add edge
        End If

        On Error GoTo 0
    Next

    Set get_perpendicular_edges = perpendicularEdges
    
End Function


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

    Dim partDoc As PartDocument
    Set partDoc = get_parent_of_T(hBody, "PartDocument")

    Dim sel As Selection
    Set sel = partDoc.Selection

    CATIA.HSOSynchronized = False

    With sel
        .Clear
        .Add hBody
        .Search "Topology.CGMEdge,sel"
    End With

    Dim edges As Collection
    Set edges = New Collection

    Dim i As Long
    For i = 1 To sel.Count2
        edges.Add sel.Item2(i).Reference
    Next

    sel.Clear
    CATIA.HSOSynchronized = True

    Set get_edges = edges

End Function


Private Function get_measurable( _
    ByVal pt As Part, _
    ByVal ref As Reference _
    ) As Measurable

    Dim wb, meas As Measurable
    Set wb = pt.Parent.GetWorkbench("SPAWorkbench")
    Set get_measurable = wb.GetMeasurable(ref)

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_item( _
    ByVal msg As String, _
    ByVal filter As Variant _
    ) As AnyObject

    Dim res As SelectedElement
    Set res = select_element(msg, filter)

    If res Is Nothing Then
        Set select_item = Nothing
    Else
        Set select_item = res.value
    End If

End Function


Private Function select_item_reference( _
    ByVal msg As String, _
    ByVal filter As Variant _
    ) As Reference

    Dim res As SelectedElement
    Set res = select_element(msg, filter)

    If res Is Nothing Then
        Set select_item_reference = Nothing
    Else
        Set select_item_reference = res.Reference
    End If

End Function


Private Function select_element( _
    ByVal msg As String, _
    ByVal filter As Variant _
    ) As SelectedElement

    Set select_element = Nothing

    Dim sel As Variant 'Selection
    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.Item2(1)

End Function
 
Hi kantoku
it is working fine i will just do little adjustment for my requirement

Thanks for your help
 
Hi kantoku

sometimes macro will select all the edges
i have selected Y axis and selected surfaces


Result_xrtksi.jpg


so this is completely depends on which axis direction user going select

what if we give a msg like "are the selected edges are required edges or not", if not select different axis direction and try again
 
NaWin55.

If you select a surface in the second selection, you will get the geometrical set to which the surface belongs.
See the selection filter.
1_mytph2.png


I only made one example of how to get edges that are perpendicular.
That is because your first question was.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor