2 Replies Latest reply on Feb 6, 2015 10:17 AM by Yong Ning

    How to move the design table

    Yong Ning

      3.jpg

       

      paste excel in drawing, follow code is true, but design table in drawingdoc , follow code is error.

       

       

       

      Sub main()

       

         Dim swModel As SldWorks.ModelDoc2

         Dim swSelMgr As SldWorks.SelectionMgr

         Dim swOleObj As SldWorks.SwOLEObject

         Dim xlObj

         Set swModel = Application.SldWorks.ActiveDoc

       

         Set swSelMgr = swModel.SelectionManager

         Set swOleObj = swSelMgr.GetSelectedObject5(1)

         Debug.Print swOleObj.FileName

         Set xlObj = swOleObj.SetActive(True)

         Debug.Print xlObj.Name

       

      End Sub

        • Re: How to move the design table
          Artem Taturevych

          Here is the macro which locates design table in the drawing to specified location (0, 0 by default)

           

          Const EXCEL_WORKSHEET_CLSID As String = "{00020830-0000-0000-C000-000000000046}"

          Const TARGET_X As Double = 0

          Const TARGET_Y As Double = 0

           

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

           

          Sub main()

           

              Set swApp = Application.SldWorks

           

              Set swModel = swApp.ActiveDoc

                 

              Dim vOleObjs As Variant

              vOleObjs = swModel.Extension.GetOLEObjects(swOleObjectOptions_e.swOleObjectOptions_GetAll)

             

              Dim i As Integer

             

              For i = 0 To UBound(vOleObjs)

                 

                  Dim swOleObj As SldWorks.SwOLEObject

                  Set swOleObj = vOleObjs(i)

                 

                  If swOleObj.Clsid = EXCEL_WORKSHEET_CLSID Then

                     

                      Dim vBounds As Variant

                      vBounds = swOleObj.Boundaries

                      Dim width As Double

                      Dim height As Double

                     

                      width = vBounds(3) - vBounds(0)

                      height = vBounds(1) - vBounds(4)

                     

                      Dim dBounds(6) As Double

                      dBounds(0) = TARGET_X: dBounds(1) = TARGET_Y: dBounds(2) = 0

                      dBounds(3) = TARGET_X + width: dBounds(4) = TARGET_Y + height: dBounds(5) = 0

           

                      swOleObj.Boundaries = dBounds

                     

                  End If

                 

              Next

             

          End Sub

           

          ______________________________________________

          Regards, Artem Taturevych | Snr. Developer | IC3D ANZ

           

          IC3DSteel – New Steel Solution for SolidWorks

          translationXpert – SolidWorks files language translator

          LinkedIn - SolidWorks API Group

            • Re: How to move the design table
              Yong Ning

              0.jpg1.jpg

              2.jpg

              Private Sub ll4()

                Dim Wk As Workbook, Sht As Worksheet, Rng As Range

                Dim ii, Str, swApp As SldWorks.SldWorks

                Set swApp = Application.SldWorks

                Dim SwModel As ModelDoc2, SwDraw As DrawingDoc

                Set SwModel = swApp.ActiveDoc

                Dim Rr, Cc

                Set Wk = GetOLEObjectsToWk(SwModel)

                Set Sht = Wk.Sheets(1)

                With Sht

               

                  Rr = .Range("A65536").End(3).Row

                  Set Rng = .Range("A4:A" & Rr)

                  'Debug.Print Rng.Address

                

                End With

               

                'Debug.Print Rng(1, 20), Rng(1, 26)

                For ii = 1 To Rng.Rows.Count

                   Str = Rng(ii, 1)

                 

                   With SwModel

                     .Extension.SelectByID2 Str, "CONFIGURATIONS", 0, 0, 0, False, 0, Nothing, 0

                     .ShowConfiguration Str

                     .ViewZoomtofit

                     .ForceRebuild3 False

                   End With

                   'Stop

                Next ii

                'SwModel.Quit

              End Sub

              Private Sub ll5()

                Dim Wk As Workbook, Sht As Worksheet, Rng As Range

                Dim ii, Str, swApp As SldWorks.SldWorks

                Set swApp = Application.SldWorks

                Dim SwModel As ModelDoc2, SwDraw As DrawingDoc

                Set SwModel = swApp.ActiveDoc

                Dim Rr, Cc

                Set Wk = GetOLEObjectsToWk(SwModel)

                Set Sht = Wk.Sheets(1)

                With Sht

                  ''

                  Rr = .Range("A65536").End(3).Row

                  Set Rng = .Range("A4:A" & Rr)

                End With

               

                'Debug.Print Rng(1, 20), Rng(1, 26)

                For ii = 1 To Rng.Rows.Count

                   Str = """SW-Material@@" & Rng(ii, 1) & "@ttmpJB4721.SLDPRT"""

                   Str = """SW-Material@@" & Rng(ii, 1) & "@" & SwModel.GetTitle & """"

                   'Debug.Print Str

                   'Stop

               

               

                   Rng(ii, "Q") = Str

                   'Str = """SW-Mass@@" & Rng(ii, 1) & "@ttmpJB4721.SLDPRT"""

                   Str = """SW-Mass@@" & Rng(ii, 1) & "@" & SwModel.GetTitle & """"

                   Debug.Print Str

                   Rng(ii, "R") = Str

                 

                Next ii

                'Stop

                'SwModel.Quit

              End Sub

              *************************************

               

              Private Sub ll1()

                Dim Xls As Excel.Application, Rng As Range

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

                  Set Rng = Xls.Selection

                 

                Dim Path, FileName, Wk As Workbook, oRng As Range

                 

                 

                Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

                  Set SwApp = Application.SldWorks

                  Set SwModel = SwApp.ActiveDoc

                 Dim SwOleObj As SwOLEObject, vOle, vv As Long

                 vOle = SwModel.Extension.GetOLEObjects(vv)

                 Set SwOleObj = vOle(1)

                 Set Wk = SwOleObj.SetActive(True)

                  ''

                  Set oRng = Wk.Sheets(1).Range("A2:Z1000")

                  oRng.Clear

               

               

                  Rng.Copy

                  oRng.PasteSpecial xlPasteValues

                  oRng.Font.Size = 9

                  Stop

                  SwOleObj.SetActive False

                  SwModel.ForceRebuild3 True

                  ''

                Dim SwDesgTab As DesignTable

                  Set SwDesgTab = SwModel.GetDesignTable

                  Stop

                  With SwDesgTab

                     .Attach

                     Stop

                     .Detach

                  End With

              End Sub