6 Replies Latest reply on Sep 21, 2017 9:42 AM by Josh Brady

    VBA - Macro wont process sketches of Holes

    Cad Admin

      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

        • Re: VBA - Macro wont process sketches of Holes
          Josh Brady

          I assume that you're talking about Hole Wizard feature holes?

           

          I haven't checked myself, but I believe the sketches for Hole Wizard holes are sub-features. 

          • Re: VBA - Macro wont process sketches of Holes
            John Alexander

             

            Just a suspicion: the problem has to do with hole wizard features containing two sketches. It looks like you are selecting each feature on the tree and then calling SketchManager.InsertSketch() to begin editing. I think this works most of the time because features tend to only have one sketch driving them. For hole wizard features, it is failing because it can't resolve which of the two sketches to begin editing.

             

            I think you'll have to change your approach to getting the sketch. Instead of selecting the feature and calling SketchManager.InsertSketch, maybe try selecting the sketch.

             

            Maybe something like this would work. It assumes that sketches are returned as child features. If so you'll also have to specify what gettypename2 returns for sketches.

             

            for each vChild in swFeature.getChildren

                 set swChildFeature = vChild

                 if swChildFeature.gettypename2 = "" then 'I'm not sure which sketch type will be returned, looks like there are several

                      bValue = swChildFeature.Select2(False, 0) 'select this feature

                      exit for

                 end if

            next vChild

             

            2012 SOLIDWORKS API Help - GetChildren Method (IFeature)

            2012 SOLIDWORKS API Help - GetSpecificFeature2 Method (IFeature)

            2012 SOLIDWORKS API Help - GetTypeName2 Method (IFeature)

              • Re: VBA - Macro wont process sketches of Holes
                Josh Brady

                Children is actually the opposite of what you want.  The Hole Wizard feature is actually a child of its sketches.  GetParents would probably work.  But that would return any features that it's dependent on.  The SubFeature route is the way to go.

                  • Re: VBA - Macro wont process sketches of Holes
                    Cad Admin

                    So add a subfeature to process Hole Wizard feature holes only, and get the sketches for them there?

                      • Re: VBA - Macro wont process sketches of Holes
                        Josh Brady

                        Sort of this-ish.

                         

                        Option Explicit
                        
                        Dim swApp As SldWorks.SldWorks
                        
                        Sub main()
                        
                            Dim swModel                 As SldWorks.ModelDoc2
                            Dim swFeature               As SldWorks.Feature
                            Dim swSubFeat               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 swSubFeat = swFeature.GetFirstSubFeature
                                While Not swSubFeat Is Nothing
                                    Debug.Print , "subFeature Name: " & swSubFeat.Name
                                    Debug.Print , "        subFeature Type: " & swSubFeat.GetTypeName2
                                    Set swSubFeat = swSubFeat.GetNextSubFeature
                                Wend
                                
                                Set swFeature = swFeature.GetNextFeature
                            Loop
                        End Sub