0 Replies Latest reply on Aug 21, 2014 4:47 AM by Manikandan Babu

    how to insert block in a drawing with part sketch point using Macro

    Manikandan Babu

      Sub main()

          Dim swApp                           As SldWorks.SldWorks

          Dim swModel                         As SldWorks.ModelDoc2

          Dim swSelMgr                        As SldWorks.SelectionMgr

          Dim swFeat                          As SldWorks.Feature

          Dim swSketch                        As SldWorks.Sketch

          Dim swSkRelMgr                      As SldWorks.SketchRelationManager

          Dim vSkRelArr                       As Variant

          Dim swSkRel                         As SldWorks.SketchRelation

          Dim relType                         As Long

          Dim i                               As Long

                 Dim Filter As String
      Dim fileName As String
      Dim fileConfig As String
      Dim fileDispName As String
      Dim fileOptions As Long
      Dim swsketchmgr As SldWorks.SketchManager
      Filter = "SolidWorks Files (*.sldprt; *.sldasm; *.slddrw)|*.sldprt;*.sldasm;*.slddrw|Filter name (*.fil)|*.fil|All Files (*.*)|*.*"
      fileName = swApp.GetOpenFileName("File to Attach", "", Filter, fileOptions, fileConfig, fileDispName)

           Set swApp = Application.SldWorks

           Set swModel = swApp.ActiveDoc

          Set swSelMgr = swModel.SelectionManager

          Set swFeat = swSelMgr.GetSelectedObject5(1)

          Set swSketch = swFeat.GetSpecificFeature2

          Set swSkRelMgr = swSketch.RelationManager

         

          vSkRelArr = swSkRelMgr.GetRelations(swAll)

         

          For i = 0 To UBound(vSkRelArr)

              Set swSkRel = vSkRelArr(i)

              relType = swSkRel.GetRelationType
      If relType = 9 Then
              Debug.Print relType
              Dim VOP As Variant
                 VOP = swSkRel.GetEntities
                         Dim LINE As SldWorks.SketchLine
                         Dim POINT As SldWorks.SketchPoint
                         Dim K As Integer
                                    Set POINT = VOP(1)
                               Debug.Print POINT.X
                               Debug.Print POINT.Y
                          Dim swsketchpoint As SldWorks.SketchPoint
      Dim swmathutility As SldWorks.MathUtility
      Dim swmathpoint As SldWorks.MathPoint
      Dim swSketchBlockDef As SldWorks.SketchBlockDefinition
      Dim vpoints  As Variant
      Dim pointcords(2)  As Double
      Dim J As Integer
               If POINT.X = 0 And POINT.Y = 0 Then
                  Else
                  pointcords(0) = (POINT.X - 0.01)
                  pointcords(1) = (POINT.Y - 0.01)
                  Set swmathutility = swApp.GetMathUtility
                  Set swsketchmgr = swModel.SketchManager
                  Set swmathpoint = swmathutility.CreatePoint(pointcords)
                           Set swSketchBlockDef = swsketchmgr.MakeSketchBlockFromFile(swmathpoint, fileName, True, 1, 0)
                  swModel.Extension.SelectByID2 "", "POINT", pointcords(0), pointcords(1), 0, True, 0, Nothing, 0
                 POINT.Select4 True, Nothing
                  swModel.SketchAddConstraints "sgCOINCIDENT"
                  swModel.ClearSelection2 True
                           End If
           End If
          Next

          End Sub