8 Replies Latest reply on May 25, 2014 3:15 AM by Deepak Gupta

    3d line

    Vishaldeep Singh

      hello

      i want to create a line with co-ordinate

      x1=50mm, y1=50mm, z1=50mm

      x2=100mm, y2=100mm, z2=100mm

       

      i recorded a macro but when i put the above values and run the macro in the output only the x,y values are there and z value is 0 means the output is coming in xy plane.

      for this i recorded a macro to create 3d sketch.

        • Re: 3d line
          Deepak Gupta

          Works fine for me. Here are the macro codes

           

          Option Explicit 

              Dim swApp                   As SldWorks.SldWorks

              Dim swModel                 As SldWorks.ModelDoc2

              Dim nPtData(6)             As Double

              Dim swSketchSeg             As SldWorks.SketchSegment

           

          Sub main()

              Set swApp = Application.SldWorks

              Set swModel = swApp.ActiveDoc

           

              'Values should be in meter. In case you want MM then divide values by 1000 as shown below.

              nPtData(0) = 50 / 1000

              nPtData(1) = 50 / 1000

              nPtData(2) = 50 / 1000

              nPtData(3) = 100 / 1000

              nPtData(4) = 100 / 1000

              nPtData(5) = 100 / 1000

           

              swModel.Insert3DSketch2 True

              Set swSketchSeg = swModel.CreateLine2(nPtData(0), nPtData(1), nPtData(2), nPtData(3), nPtData(4), nPtData(5))

              swModel.Insert3DSketch2 True

           

          End Sub

            • Re: 3d line
              Vishaldeep Singh

              Thank you so much sir...

              • Re: 3d line
                Ar K

                If you forced to (because  some features don't accept 3DSketch) using  " swModel.InsertSketch2 "   for drawing a line between p1(x1,y1,z1) and p2(x2,y2,z2)

                i think you must using :


                IRefPlane::Transform

                ISketch::ModelToSketchTransform

                 


                • Re: 3d line
                  Vishaldeep Singh

                  sir is this coding will work for curve instead of points.

                  what will be changes then...

                    • Re: 3d line
                      Deepak Gupta

                      Option Explicit

                          Dim swApp                   As SldWorks.SldWorks

                          Dim swModel                 As SldWorks.ModelDoc2

                          Dim nPtData(9)              As Double

                          Dim vPtData                 As Variant

                          Dim swSketchSeg             As SldWorks.SketchSegment

                       

                      Sub main()

                          Set swApp = Application.SldWorks

                          Set swModel = swApp.ActiveDoc

                       

                          'Values should be in meter. In case you want MM then divide values by 1000 as shown below.

                          nPtData(0) = 50 / 1000

                          nPtData(1) = 50 / 1000

                          nPtData(2) = 50 / 1000

                          nPtData(3) = 200 / 1000

                          nPtData(4) = 150 / 1000

                          nPtData(5) = 120 / 1000

                          nPtData(6) = 150 / 1000

                          nPtData(7) = 350 / 1000

                          nPtData(8) = 150 / 1000

                         

                          vPtData = nPtData

                       

                          swModel.Insert3DSketch2 True

                          Set swSketchSeg = swModel.CreateSpline(vPtData)

                          swModel.Insert3DSketch2 True

                       

                      End Sub

                        • Re: 3d line
                          Vishaldeep Singh

                          that is ok but sir i specifically need a curve command

                          • Re: 3d line
                            Vishaldeep Singh

                            not working

                             

                            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()

                                part.AddToDB = False

                            End Sub