2 Replies Latest reply on Mar 21, 2017 4:43 AM by Wesley Prins

    Save as Edrawing

    Wesley Prins

      Hi all

       

      I'm trying to make a vb.net app to save all assemblies in a assembly as a edrawing file.

       

      But i can't figure out why this code below isnt working.

      There must be something obvious that i don't see but i spend quite some time now trying different ways but can't seem to figure it out.

      could you please help?

       

      Please find below the code:

       

      sub main

             Frm_start.Cursor = Cursors.AppStarting

              Dim swApp As SldWorks

              Dim swModel As ModelDoc2

              Dim swConf As Configuration

              Dim swConfMgr As ConfigurationManager

              Dim swDerivConf As Configuration

              swApp = GetObject(, "sldworks.application")

       

              Dim swm As ModelDoc2 = swApp.ActiveDoc

       

              'get model

              swModel = swm

       

              'check if assembly

              Dim modeltype As Integer = swModel.GetType

              If modeltype <> 2 Then

                  MsgBox("FUNCTIONNE UNIQUEMENT SUR DES ASSEMBLAGES")

                  Exit Sub

              End If

       

              Dim pathedrawing As String = fileloc("pathglobal") & "EASM\"

              Dim filename As String = swModel.GetPathName

              Dim fn As String = pathedrawing & gettextfromright(gettextfromright(filename, ".", 0), "\", 1) & "(" & SW_get_custom_properties("Description") & ").easm"

              Dim fns As New List(Of String)

              fns.Add(fn)

       

              swModel.SaveAs4(fn, 0, 0, 0, 0)

       

              Dim swass As AssemblyDoc = swModel

              Dim vcomponents As Object = swass.GetComponents(True)

              Dim swc As Component

              Dim comc As Integer = swass.GetComponentCount(True)

       

              'each component check

              For a = 0 To comc - 1

                  swc = vcomponents(a)

                  Dim cn As String = swc.GetPathName

       

                  'check assembly

                  Dim assy As Boolean = False

                  If cn.Contains(".SLDASM") = True Then

                      assy = True

                  End If

                  If cn.Contains(".sldasm") = True Then

                      assy = True

                  End If

                  If assy = False Then

                      Continue For

                  End If

       

                  Dim refconfig As String = swc.ReferencedConfiguration

                  Dim fileerror As Integer

                  Dim filewarning As Integer

                  swModel = swApp.OpenDoc6(cn, swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_e.swOpenDocOptions_Silent, refconfig, fileerror, filewarning)

                  Dim pthea As String = pathedrawing & gettextfromright(gettextfromright(swModel.GetPathName, ".", 0) & ".easm", "\", 1)

                  swModel.SaveAs3(pthea, 0, 0)

                  fns.Add(pthea)

              Next

       

              Dim msg As String = ""

              For Each f In fns

                  msg = msg & vbNewLine & f

              Next

       

              MsgBox("SAVED: " & msg)

              Frm_start.Cursor = Cursors.Default

      end sub

       

        • Re: Save as Edrawing
          Deepak Gupta

          Not sure on VB.NET but try these VBA codes. Change as needed.

           

          Option Explicit
            Dim swApp                    As SldWorks.SldWorks
            Dim swModel                  As SldWorks.ModelDoc2
            Dim swConfigMgr              As SldWorks.ConfigurationManager
            Dim swAssy                    As SldWorks.AssemblyDoc
            Dim swConf                    As SldWorks.Configuration
            Dim swRootComp                As SldWorks.Component2
            Const PatheDrawing            As String = "C:\Users\DEEPAK\Desktop\Test\" 'Change Path Here
          
          Sub main()
            Set swApp = Application.SldWorks
            Set swModel = swApp.ActiveDoc
            Set swConfigMgr = swModel.ConfigurationManager
            Set swConf = swConfigMgr.ActiveConfiguration
            Set swRootComp = swConf.GetRootComponent3(True)
            TraverseComponent swRootComp, 1
          
          End Sub
          
          Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long)
             
              Dim swChildComp As SldWorks.Component2
              Dim swCompModel As SldWorks.ModelDoc2
              Dim CompModel  As SldWorks.ModelDoc2
              Dim vChildComp  As Variant
              Dim filename    As String
              Dim nErrors    As Long
              Dim nWarnings  As Long
              Dim i          As Long
          
              vChildComp = swComp.GetChildren
             
              For i = 0 To UBound(vChildComp)
                  Set swChildComp = vChildComp(i)
                  Set swCompModel = swChildComp.GetModelDoc2
                  If swCompModel.GetType = swDocASSEMBLY Then
                      Set CompModel = swApp.ActivateDoc3(swChildComp.GetPathName, False, 2, nErrors)
                      filename = Mid(swChildComp.GetPathName, InStrRev(swChildComp.GetPathName, "\") + 1)
                      filename = Left(filename, InStrRev(filename, ".")) & "EASM"
                      CompModel.Extension.SaveAs PatheDrawing & filename, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings
                      swApp.CloseDoc swChildComp.GetPathName
                  End If       
                  TraverseComponent swChildComp, nLevel + 1
              Next i
             
          End Sub
          
            • Re: Save as Edrawing
              Wesley Prins

              Thanks Deepak that got me to the solution.

              Got a working code now, maybe not very pretty but functional.

              For anyone interested here is the code:

               

              Sub SAVE_AS_EDRAWING(ByVal nth As String)

               

                      Frm_start.Cursor = Cursors.AppStarting

               

                      Dim swApp As SldWorks

                      Dim swModel As ModelDoc2

                      swApp = GetObject(, "sldworks.application")

                      Dim swm As ModelDoc2 = swApp.ActiveDoc

               

                      'get model

                      swModel = swm

               

                      'check if assembly

                      Dim modeltype As Integer = swModel.GetType

                      If modeltype <> 2 Then

                          MsgBox("FUNCTIONNE UNIQUEMENT SUR DES ASSEMBLAGES")

                          Exit Sub

                      End If

               

                      'save assemblies in model as edrawing

                      Dim swConfigMgr As ConfigurationManager = swModel.ConfigurationManager

                      Dim swConf As Configuration = swConfigMgr.ActiveConfiguration

                      Dim swRootComp As Component = swConf.GetRootComponent3(True)

                      Dim fls As String = "File Processed:" & vbNewLine

                      fls = fls & SaveAssyAsEdrawing(swRootComp)

               

                      'save assembly as edrawing

                      Dim pathedrawing As String = fileloc("pathglobal") & "EASM\"

                      Dim filename As String = swModel.GetPathName

                      Dim fn As String = pathedrawing & gettextfromright(gettextfromright(filename, ".", 0), "\", 1) & "(" & SW_get_custom_properties("Description") & ").easm"

                      swModel.SaveAs3(fn, 0, 1)

                      fls = fls & vbNewLine & "Saved: " & gettextfromright(fn, "\", 1)

                      fls = fls & vbNewLine & vbNewLine & "In Directory: " & pathedrawing

                      MsgBox(fls)

               

                      Frm_start.Cursor = Cursors.Default

               

                  End Sub

               

                  Function SaveAssyAsEdrawing(ByVal swComp As Component) As String

                      Dim swApp As SldWorks

                      swApp = GetObject(, "sldworks.application")

                      Dim swChildComp As Component

                      Dim swCompModel As ModelDoc

                      Dim CompModel As ModelDoc

                      Dim vChildComp As Object

                      Dim filename As String

                      Dim nErrors As Integer

                      Dim i As Long

                      Dim PatheDrawing As String = fileloc("pathglobal") & "EASM\"

                      Dim fn As List(Of String)

                      Dim fls As String = ""

               

                      vChildComp = swComp.GetChildren

               

                      For i = 0 To UBound(vChildComp)

                          swChildComp = vChildComp(i)

                          swCompModel = swChildComp.GetModelDoc2

                          If swCompModel.GetType = 2 Then

                              CompModel = swApp.ActivateDoc3(swChildComp.GetPathName, False, 2, nErrors)

                              filename = gettextfromright(swChildComp.GetPathName, "\", 1)

                              filename = gettextfromright(filename, ".", 0) & "(" & SW_get_custom_properties("Description") & ").EASM"

                              If IO.File.Exists(PatheDrawing & filename) Then

                                  Try

                                      IO.File.Delete(PatheDrawing & filename)

                                  Catch ex As ExternalException

                                      If IsNothing(ex) = False Then

                                          fls = fls & vbNewLine & "File Open: " & PatheDrawing & filename

                                          GoTo nti

                                      End If

                                  End Try

                              End If

                              CompModel.SaveAs3(PatheDrawing & filename, 0, 1)

                              fls = fls & vbNewLine & "Saved: " & filename

                              swApp.CloseDoc(swChildComp.GetPathName)

               

                          End If

              nti:

                      Next i

                      Return fls

               

                  End Function