Get Silhouette Edge Example (VBA)

This example shows how to get the silhouette edge to which an annotation is attached in a drawing.

 

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

'

' Prerequisites: RealEdgeAsSilhouette.SLDDRW exists, and

'                an annotation is attached to a silhouette

'                edge in Drawing View2.

'

' Postconditions: The silhouette edge is selected, then

'                RealEdgeAsSilhouette.SLDDRW is closed.

'

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

Option Explicit

Sub main()

    

    Dim SwApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim SelMgr As SldWorks.SelectionMgr

    Dim MacroFolder As String

    Dim PartFolder As String

    Dim LongStatus As Long

    Dim LongWarnings As Long

    Dim BoolStatus As Boolean

    

    If SwApp Is Nothing Then Set SwApp = Application.SldWorks

 

    'Get folder paths

    MacroFolder = Left(SwApp.GetCurrentMacroPathName(), InStrRev(SwApp.GetCurrentMacroPathName(), "\"))

    PartFolder = MacroFolder

    

    'Set current eorking directory to the parts folder

    SwApp.SetCurrentWorkingDirectory PartFolder

    ' Open file

    Set swModel = SwApp.OpenDoc6("RealEdgeAsSilhouette.SLDDRW", SwConst.swDocumentTypes_e.swDocDRAWING, 0, "", LongStatus, LongWarnings)

    If swModel Is Nothing Then ErrorMsg SwApp, "Failed to open: ", True

 

    Dim drDoc As SldWorks.DrawingDoc

    Dim drView As SldWorks.View

    

    ' Activate the drawing view with the annotation

    Set drDoc = swModel

    BoolStatus = drDoc.ActivateView("Drawing View2")

    Set drView = drDoc.ActiveDrawingView

    

    Dim params

    Dim vobj

    Dim silEdge As SldWorks.SilhouetteEdge

    Dim drAnn As SldWorks.Annotation

    

    ' Get the annotation and any attached entities

    Set drAnn = drView.GetFirstNote.GetAnnotation

    params = drAnn.GetAttachedEntities3

    ' If the attached entity is a silhouette edge, then select it

    For Each vobj In params

        Set silEdge = vobj

        BoolStatus = silEdge.Select(False, Nothing)

    Next vobj

    'Close documents

    SwApp.CloseDoc swModel.GetTitle

    'Set objects to Nothing

    Set swModel = Nothing

        

End Sub

 

' Error function

Function ErrorMsg(SwApp As Object, Message As String, EndTest As Boolean)

    SwApp.SendMsgToUser2 Message, 0, 0

    SwApp.RecordLine "'*** WARNING - General"

    SwApp.RecordLine "'*** " & Message

    SwApp.RecordLine ""

    If EndTest Then

        SwApp.ExitApp

        End

    End If

End Function