4 Replies Latest reply on Jun 8, 2014 11:37 PM by Vishaldeep Singh

    i want to make two 3d sketch

    Vishaldeep Singh

      hello

      in the attachment there is excel file and macro file.

      there is a special symbol "$" in the  excel sheet and i want upto $ sign the point must generate in 1st 3d sketch and after $ sign the points should generate in 2nd 3d sketch

       

      so my question is is this thing possible in macro coding.

        • Re: i want to make two 3d sketch
          Ivana Kolin

          Option Explicit

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swSketchMgr As SldWorks.SketchManager

          Dim swExcel As Excel.Application

          Dim exSheet As Excel.Worksheet

          Dim i As Integer

          Dim sVal As String

          Dim xpt As Double

          Dim ypt As Double

          Dim zpt As Double

           

           

           

          Sub main()

           

           

              Set swApp = Application.SldWorks

              Set swModel = swApp.ActiveDoc

             

              Set swExcel = GetObject(, "Excel.Application")

              Set exSheet = swExcel.ActiveSheet

           

           

              Set swModel = swApp.ActiveDoc

              Set swSketchMgr = swModel.SketchManager

           

           

              Dim skPoint As SketchPoint

              swSketchMgr.AddToDB = True

              swSketchMgr.Insert3DSketch False

           

           

              i = 1

             

              Do While exSheet.Cells(i, 1).Value <> ""

                  sVal = exSheet.Cells(i, 1).Value

                  If sVal = "$" Then

                      swSketchMgr.Insert3DSketch False

                      swModel.ClearSelection2 True

                      swSketchMgr.Insert3DSketch False

                  Else

                      xpt = exSheet.Cells(i, 1).Value

                      ypt = exSheet.Cells(i, 2).Value

                      zpt = exSheet.Cells(i, 3).Value

                     

                      xpt = xpt * 0.001

                      ypt = ypt * 0.001

                      zpt = zpt * 0.001

                     

                      Set skPoint = swSketchMgr.CreatePoint(xpt, ypt, zpt)

                  End If

                  i = i + 1

              Loop

              swSketchMgr.Insert3DSketch True

              swSketchMgr.AddToDB = False

          End Sub

            • Re: i want to make two 3d sketch
              Vishaldeep Singh

              sir is this code work for curve also? could you please suggest me the modification in this code for curve..

               

              Dim swApp As SldWorks.SldWorks

              Dim swModel As SldWorks.ModelDoc2

              Dim swSketchMgr As SldWorks.SketchManager

              Dim swExcel As Excel.Application

              Dim exSheet As Excel.Worksheet

              Dim i As Integer

              Dim sVal As String

              Dim xpt As Double

              Dim ypt As Double

              Dim zpt As Double

              Sub main()

              Set swApp = Application.SldWorks

                  Set swModel = swApp.ActiveDoc

                 Set part = swApp.ActiveDoc

                  Set swExcel = GetObject(, "Excel.Application")

                  Set exSheet = swExcel.ActiveSheet

               

               

                  Set swModel = swApp.ActiveDoc

                  Set swSketchMgr = swModel.SketchManager

              part.AddToDB = True

               

              part.InsertCurveFileBegin False

               

               

              i = 1

                

                  Do While exSheet.Cells(i, 1).Value <> ""

                      sVal = exSheet.Cells(i, 1).Value

                      If sVal = "$" Then

                          part.InsertCurveFileBegin False

                          part.ClearSelection2 True

                          part.InsertCurveFileBegin False

                      Else

                     

                      xpt = exSheet.Cells(i, 1).Value

                      ypt = exSheet.Cells(i, 2).Value

                      zpt = exSheet.Cells(i, 3).Value

                      xpt = xpt * 0.001

                          ypt = ypt * 0.001

                          zpt = zpt * 0.001

                      boolstatus = part.InsertCurveFilePoint(xpt, ypt, zpt)

                       End If

                  i = i + 1

                  Loop

                  boolstatus = part.InsertCurveFileEnd True

                  part.AddToDB = False

              End Sub

                • Re: i want to make two 3d sketch
                  Deepak Gupta

                  Try these:

                   

                  Dim swApp As SldWorks.SldWorks

                  Dim swModel As SldWorks.ModelDoc2

                  Dim swSketchMgr As SldWorks.SketchManager

                  Dim swExcel As Excel.Application

                  Dim exSheet As Excel.Worksheet

                  Dim i As Integer

                  Dim sVal As String

                  Dim xpt As Double

                  Dim ypt As Double

                  Dim zpt As Double

                  Sub main()

                  Set swApp = Application.SldWorks

                      Set swModel = swApp.ActiveDoc

                      Set swExcel = GetObject(, "Excel.Application")

                      Set exSheet = swExcel.ActiveSheet

                      Set swSketchMgr = swModel.SketchManager

                   

                   

                  swModel.InsertCurveFileBegin

                  i = 1

                        Do While exSheet.Cells(i, 1).Value <> ""

                          sVal = exSheet.Cells(i, 1).Value

                          If sVal = "$" Then

                              swModel.InsertCurveFileEnd

                              swModel.ClearSelection2 True

                              swModel.InsertCurveFileBegin

                          Else

                        

                          xpt = exSheet.Cells(i, 1).Value * 0.001

                          ypt = exSheet.Cells(i, 2).Value * 0.001

                          zpt = exSheet.Cells(i, 3).Value * 0.001

                          boolstatus = swModel.InsertCurveFilePoint(xpt, ypt, zpt)

                           End If

                      i = i + 1

                      Loop

                      boolstatus = swModel.InsertCurveFileEnd

                  End Sub