8 Replies Latest reply on Mar 28, 2018 8:42 AM by Matthew Davey

    creating a sketch on a new plane

    M. Doga Dogan



      I would like to write a macro that creates a new plane with a given distance dynamically, and then starts a 2D sketch on it. Therefore I need to select the newly created plane before I start the sketch. I couldn't understand how to choose a newly created plane.


      My current code looks like this:


          Dim myRefPlane As Object

          Distance = Distance / 1000

          Set myRefPlane = Part.FeatureManager.InsertRefPlane(8, Distance, 0, 0, 0, 0)

          Part.ClearSelection2 True

          boolstatus = Part.Extension.SelectByID2("Plane1", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

          Part.SketchManager.InsertSketch True


      The code above just assumes that the new plane is called Plane1, however, this might not be the case. Any ideas?


      Thank you

        • Re: creating a sketch on a new plane
          Abilash V.

          Dim swApp As SldWorks.SldWorks

          Dim swmodel As SldWorks.ModelDoc2

          Dim swfeat As SldWorks.Feature

          Dim var As Variant

          Dim swfeatmgr As SldWorks.FeatureManager

          Dim n As Integer

          Dim plan As Variant

          Dim swplan As SldWorks.Feature

          Dim bool As Boolean

          Sub main()

          Set swApp = Application.SldWorks

          Set swmodel = swApp.ActiveDoc

          Set swfeatmgr = swmodel.FeatureManager

          var = swfeatmgr.GetFeatures(False)

          For i = 0 To UBound(var)

          Set swfeat = var(i)

          If swfeat.GetTypeName2 = "RefPlane" Then

          n = i

          Debug.Print swfeat.Name & "  " & swfeat.GetTypeName2

          End If


          bool = var(n).Select2(False, 0)

          End Sub


          'This would automatically select the last created plane.

          'Hope it helps.

          • Re: creating a sketch on a new plane
            Andreas Killer

            Get the last added feature from the ModelDocExtension object.




            Option Explicit


            Sub Main()
              Dim swApp As SldWorks.SldWorks
              Dim swModel As SldWorks.ModelDoc2
              Dim swExt As SldWorks.ModelDocExtension
              Dim Distance


              'Refer to the current model
              Set swApp = Application.SldWorks
              Set swModel = swApp.ActiveDoc
              Set swExt = swModel.Extension
              'Be sure a plane is selected
              Dim swSelMgr As SldWorks.SelectionMgr
              Set swSelMgr = swModel.SelectionManager
              With swSelMgr
                If .GetSelectedObjectCount2(-1) = 0 Then
                  MsgBox "Select a plane and try again"
                End If
                If .GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelDATUMPLANES Then
                  MsgBox "Select a plane and try again"
                End If
              End With


              'Ask for the distance
              Distance = InputBox("Distance in mm:")
              If Not IsNumeric(Distance) Then Exit Sub
              'Change to meters
              Distance = Distance / 1000
              'Insert the new plane
              Dim myRefPlane As SldWorks.RefPlane
              Set myRefPlane = swModel.FeatureManager.InsertRefPlane(swRefPlaneReferenceConstraints_e.swRefPlaneReferenceConstraint_Distance, Distance, 0, 0, 0, 0)
              'Get the last feature
              Dim swFeature As SldWorks.Feature
              Set swFeature = swExt.GetLastFeatureAdded
              'Select it
              swFeature.Select2 False, -1
              'Insert a sketch
              swModel.SketchManager.InsertSketch True
            End Sub