AnsweredAssumed Answered

VBA - Macro wont process sketches of Holes

Question asked by Cad Admin on Sep 21, 2017
Latest reply on Sep 21, 2017 by Josh Brady

Macro below processes a part and fully defines all sketches.

 

The Issue is it wont find/process the sketches of holes. It processes all other features, but holes it skips.  The debug also shows all features except hole sketches.  I have use other macros from the API, to select the sketches manually and they show as expected, as "Feature Type: ProfileFeature".

 

Open to all thoughts....

 

Option Explicit

 

Dim swApp As SldWorks.SldWorks

 

Sub main()

 

    Dim swModel                 As SldWorks.ModelDoc2

    Dim swFeature               As SldWorks.Feature

    Dim bValue                  As Boolean

    Dim swSketchManager         As SldWorks.SketchManager

    Dim swModelExtension        As SldWorks.ModelDocExtension

    Dim lStatus                 As Long

    Dim lMarkHorizontal         As Long

    Dim lMarkVertical           As Long

    Dim swSelectionManager      As SldWorks.SelectionMgr

 

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swModelExtension = swModel.Extension

    Set swSketchManager = swModel.SketchManager

    Set swSelectionManager = swModel.SelectionManager

 

    swModel.ClearSelection2 True

 

    ' These are the marks expected for the dimension datums

    lMarkHorizontal = 2

    lMarkVertical = 4

 

    Set swFeature = swModel.FirstFeature

   

    Do While (Not (swFeature Is Nothing))

        Debug.Print "Feature Name: " & swFeature.Name

        Debug.Print "        Feature Type: " & swFeature.GetTypeName2

        If (swFeature.GetTypeName2 = "ProfileFeature") Then

            If (Not (swFeature Is Nothing)) Then

                bValue = swFeature.Select2(False, 0)

                swSketchManager.InsertSketch False

 

                bValue = swModelExtension.SelectByID2("Point1@Origin", "EXTSKETCHPOINT", 0, 0, 0, False, lMarkHorizontal Or lMarkVertical, Nothing, 0)

                lStatus = swSketchManager.FullyDefineSketch(True, True, swSketchFullyDefineRelationType_e.swSketchFullyDefineRelationType_Vertical Or swSketchFullyDefineRelationType_e.swSketchFullyDefineRelationType_Horizontal, True, 1, Nothing, 1, Nothing, 1, 1)

                swSketchManager.InsertSketch True

            End If

            'Exit Do

        End If

        Set swFeature = swFeature.GetNextFeature

    Loop

End Sub

Outcomes