30 Replies Latest reply on Mar 24, 2018 3:53 AM by Andreas Beck

    Macro for search .SLDDRW in different folder that .SLDPRT any help me ?

    Geraldo Fernandes

      I need a macro for search .SLDDRW in different folder. SW2016 have a icon but this funcion search only same folder that .SLDPRT. Any help me? Thaks

        • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
          Artem Taturevych

          The best way would be to use 2017 SOLIDWORKS API Help - WhereUsed Method (ISwDMDocument) and utilize the pSrcOption parameter to specify the additional paths to search: 2017 SOLIDWORKS API Help - AddSearchPath Method (ISwDMSearchOption)

           

          You can also use the reversed method. I.e. find all drawing files in the nominated search folder and get its children to find which one is a reference for a given assembly: 2015 SOLIDWORKS API Help - GetDocumentDependencies2 Method (ISldWorks)

           

          Thanks,
          Artem

            • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
              Geraldo Fernandes

              Thank you Artem for your reply. But I do not have much experience in writing macro... even though it has many help in the help still yes, basic problems appear. Could you help me to format this macro? Follow below what you sent me...

               

              Function WhereUsed( _
                 ByVal pSrcOption As SwDMSearchOption _
              ) As System.Object
              Visual Basic(Usage)

              Dim instance As ISwDMDocument
              Dim pSrcOption As SwDMSearchOption
              Dim value As System.Object

              value = instance.WhereUsed(pSrcOption)

              Sub AddSearchPath( _
                 ByVal newPath As System.String _
              )
              Visual Basic(Usage)

              Dim instance As ISwDMSearchOption
              Dim newPath As System.String

              instance.AddSearchPath (newPath)

            • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
              Joel Condevaux

              Hi,

               

              Here you can find a program able to find where a part or assembly is used. https://forum.solidworks.com/thread/113829

              • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                Elmar Klammer

                Hi Geraldo,

                 

                Search for Solid-open-Drawing at ww3.cad.de....it does in principle what you want.

                 

                Elmar

                  • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                    Geraldo Fernandes

                    Hi Elmar. Thank you!

                     

                    I have test this macro and a problem this I a no have work with PDM... I cleaned the macro but it's not working properly.

                    Can you help me?

                        • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                          Geraldo Fernandes

                          Hi Elmar. Thak you!

                          I did as you indicated and the search does not find the drawing in the sub folder...

                          You can see what's wrong?

                           

                          ' ------------------------------------------------------------------------------

                          Const swDocPART = 1
                          Const swDocASSEMBLY = 2
                          Const swDocDRAWING = 3
                          Const swSelEDGES = 1
                          Const swSelFACES = 2
                          Const swSelVERTICES = 3

                          Public Declare PtrSafe Function _
                          ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                          (ByVal hwnd As Long, _
                          ByVal lpOperation As String, _
                          ByVal lpFile As String, _
                          ByVal lpParameters As String, _
                          ByVal lpDirectory As String, _
                          ByVal nShowCmd As Long) As Long

                          Public Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" ( _
                              ByVal RootPath As String, _
                              ByVal FileName As String, _
                              ByVal OutputPath As String _
                            ) As Long

                          Dim PathName            As String            'Caminho do arquivo incluido nomes de arquivos e extensao


                          Sub Main()

                              Dim swApp               As Object
                              Dim swModel             As Object           'Documento ativo
                              Dim FileName            As String           'Nome do arquivo sem caminho
                              Dim txtPathName         As String           'Caminho do arquivo incluido FileName sem extensao
                              Dim DwgPath             As String           'Caminho do arquivo incluido FileName e extensao
                              Dim DwgName             As String           'O nome do documento ativo com extensao
                              Dim myDwgDoc            As Object           'Desenho para abrir
                              Dim CloseErrors         As Long             'Para swApp.OpenDoc6
                              Dim CloseWarnings       As Long             'Para swApp.OpenDoc6
                              Dim SelMgr              As Object
                              Dim selType             As Long
                              Dim swComp              As Object
                              Dim i                   As Long
                              Dim s                   As String * 1024
                              Dim FindFile            As String
                              Dim longstatus          As Long
                              Dim longwarnings        As Long

                              Set swApp = CreateObject("SldWorks.Application")
                              Set swModel = swApp.ActiveDoc                                               'Documento ativo
                             
                              If swModel Is Nothing Then                                                  'Se nenhum documento estiver aberto,
                                  Call MsgBox("Nenhum documento aberto!", vbSystemModal, "Atenção")    'Mensagem
                                  Exit Sub                                                                'e sair
                              End If

                              If (swModel.GetType = swDocDRAWING) Then                                    'Quando um desenho é aberto,
                                  Call MsgBox("Um desenho já está aberto!", vbSystemModal, "Atenção")    'Mensagem
                                  Exit Sub                                                                'e sair
                              End If
                             
                              'Consulta se o documento foi salvo e, se necessário, prompt para salvar
                              If swModel.GetPathName = "" Then
                                  swModel.Save                                                            'Salvar documento ativo como
                                  End                                                                     'Sair macro
                              End If
                             

                              'Se o assembly, em seguida, verifique se algo está selecionado
                              If (swModel.GetType = swDocASSEMBLY) Then
                                  Set SelMgr = swModel.SelectionManager                                   'Obter a interface SelectionMgr
                                  selType = SelMgr.GetSelectedObjectType2(1)                              'Verifique o tipo de objeto selecionado
                                 
                                 'Se algo for selecionado, defina todas as propriedades desejadas aqui
                                  If ((selType = 1) Or _
                                      (selType = 2) Or _
                                      (selType = 3)) Then                                                 'Se item é face, edge ou vertex
                                     
                                      Set swComp = SelMgr.GetSelectedObjectsComponent(1)
                                      PathName = swComp.GetPathName                                       'Caminho do arquivo incl. FileName e extensao
                                      FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName)) 'Nome do arquivo com extensao
                                      FileName = VBA.Left(FileName, Len(FileName) - 7)                    'Nome do arquivo sem extensao

                                  Else
                                      'Veja se algo está selecionado no FeatureManager
                                      'Considere todos os itens selecionados
                                      For i = 1 To SelMgr.GetSelectedObjectCount2(-1) + 1
                                          'Existe um componente para a seleção?
                                          Set swComp = SelMgr.GetSelectedObjectsComponent(i)
                                          If Not swComp Is Nothing Then
                                              PathName = swComp.GetPathName                               'Caminho do arquivo incl. FileName e extensor
                                              FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName)) 'Nome do arquivo com extensao
                                              FileName = VBA.Left(FileName, Len(FileName) - 7)                    'Nome do arquivo sem extensao

                                              Exit For
                                          End If
                                      Next i
                                  End If
                              End If
                             
                              'Se nada for selecionado, defina todas as propriedades desejadas aqui
                              If FileName = "" Then
                                  PathName = swModel.GetPathName                                          'Caminho do arquivo incl. FileName e extensao
                                  FileName = swModel.GetTitle                                             'Nome do arquivo com extensao
                                  FileName = VBA.Left(FileName, Len(FileName) - 7)                        'Nome do arquivo sem extensao

                              End If
                             

                              'Definir nomes de desenho
                             
                              If SearchTreeForFile("T:\Geraldo\Data", DwgName, s) Then
                                  FindFile = Left$(s, InStr(s, vbNullChar) - 1)
                                  'Call MsgBox(FindFile, vbSystemModal, "Atenção")
                                  ShellExecute 0, "open", FindFile, "", "", SHOWMAXIMIZED
                              End If
                             
                              txtPathName = VBA.Left(PathName, Len(PathName) - 7)                         'Caminho do arquivo incl. FileName sem extensao
                             
                              DwgPath = txtPathName + ".SLDDRW"

                              DwgName = FileName + ".SLDDRW"
                                 
                                 
                              'Desenho aberto
                              Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", CloseErrors, CloseWarnings)   'O desenho abre
                            
                             
                              ' Verificar se encontrado
                              If myDwgDoc Is Nothing Then                                                 'Se nenhum desenho foi encontrado
                                  Call MsgBox("Desenho não encontrado" & vbCrLf & DwgPath, vbSystemModal, "Atenção")                    'Desenho não encontrado
                              End If
                             
                          End Sub

                            • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                              Elmar Klammer

                              Hi Geraldo,

                               

                              Open the macro editor and step through the macro. Hit F8 to go through the code line by line. Add a debug.print DwgPath to see what path is eventually passed into your variable.

                              You need to define DwgName before you pass it in the searchtreeforFile call. In your code is after. Add debug.print DwgName before the searchtreeforfile call and you will see what i mean.

                               

                              Elmar

                                • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                                  Geraldo Fernandes

                                  Hi Elmar,

                                   

                                  So, no difference

                                  See in the image that the drawing exists in another folder. But the macro was not looking for it...

                                  The macro still looks in the same folder as the part.

                                   

                                    • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                                      Andreas Beck

                                      Hi Geraldo,

                                      you should compare again with my macro Solid-Open-PDF.
                                      I suggest you make some changes, and hope that it will take you a bit further.

                                       

                                      Solid-open-SLDDRW.JPG

                                       

                                      -------------------------------------------

                                      If FileName = "" Then

                                           PathName = swModel.GetPathName

                                      End If

                                       

                                      FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName))

                                      FileName = VBA.Left(FileName, Len(FileName) - 7) 

                                       

                                      DwgName = FileName + ".SLDDRW"

                                       

                                      If SearchTreeForFile("T:\Geraldo\Data", DwgName, s) Then

                                           FindFile = Left$(s, InStr(s, vbNullChar) - 1)

                                      End If

                                       

                                      Set myDwgDoc = swApp.OpenDoc6(FindFile, swDocDRAWING,

                                      swOpenDocOptions_Silent, "", CloseErrors, CloseWarnings)

                                       

                                      -----------------------------------------------

                                       

                                      Look at it and let me know if that is so much better.
                                      Greetings, Andi

                                        • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                                          Geraldo Fernandes

                                          Hi Andi. Thank you!

                                          sorry,

                                          I try but not find any file now...

                                           

                                           

                                          ' ------------------------------------------------------------------------------

                                          Const swDocPART = 1
                                          Const swDocASSEMBLY = 2
                                          Const swDocDRAWING = 3
                                          Const swSelEDGES = 1
                                          Const swSelFACES = 2
                                          Const swSelVERTICES = 3

                                          Public Declare PtrSafe Function _
                                          ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                          (ByVal hwnd As Long, _
                                          ByVal lpOperation As String, _
                                          ByVal lpFile As String, _
                                          ByVal lpParameters As String, _
                                          ByVal lpDirectory As String, _
                                          ByVal nShowCmd As Long) As Long

                                          Public Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" ( _
                                              ByVal RootPath As String, _
                                              ByVal FileName As String, _
                                              ByVal OutputPath As String _
                                            ) As Long

                                          Dim PathName            As String            'Caminho do arquivo incluido nomes de arquivos e extensao


                                          Sub Main()

                                              Dim swApp               As Object
                                              Dim swModel             As Object           'Documento ativo
                                              Dim FileName            As String           'Nome do arquivo sem caminho
                                              Dim txtPathName         As String           'Caminho do arquivo incluido FileName sem extensao
                                              Dim DwgPath             As String           'Caminho do arquivo incluido FileName e extensao
                                              Dim DwgName             As String           'O nome do documento ativo com extensao
                                              Dim myDwgDoc            As Object           'Desenho para abrir
                                              Dim CloseErrors         As Long             'Para swApp.OpenDoc6
                                              Dim CloseWarnings       As Long             'Para swApp.OpenDoc6
                                              Dim SelMgr              As Object
                                              Dim selType             As Long
                                              Dim swComp              As Object
                                              Dim i                   As Long
                                              Dim s                   As String * 1024
                                              Dim FindFile            As String
                                              Dim longstatus          As Long
                                              Dim longwarnings        As Long

                                              Set swApp = CreateObject("SldWorks.Application")
                                              Set swModel = swApp.ActiveDoc                                               'Documento ativo
                                             
                                              If swModel Is Nothing Then                                                  'Se nenhum documento estiver aberto,
                                                  Call MsgBox("Nenhum documento aberto!", vbSystemModal, "Atenção")       'Mensagem
                                                  Exit Sub                                                                'e sair
                                              End If

                                              If (swModel.GetType = swDocDRAWING) Then                                    'Quando um desenho é aberto,
                                                  Call MsgBox("Um desenho já está aberto!", vbSystemModal, "Atenção")     'Mensagem
                                                  Exit Sub                                                                'e sair
                                              End If
                                             
                                              'Consulta se o documento foi salvo e, se necessário, prompt para salvar
                                              If swModel.GetPathName = "" Then
                                                  swModel.Save                                                            'Salvar documento ativo como
                                                  End                                                                     'Sair macro
                                              End If
                                             

                                              'Se o assembly, em seguida, verifique se algo está selecionado
                                              If (swModel.GetType = swDocASSEMBLY) Then
                                                  Set SelMgr = swModel.SelectionManager                                   'Obter a interface SelectionMgr
                                                  selType = SelMgr.GetSelectedObjectType2(1)                              'Verifique o tipo de objeto selecionado
                                                 
                                                 'Se algo for selecionado, defina todas as propriedades desejadas aqui
                                                  If ((selType = 1) Or _
                                                      (selType = 2) Or _
                                                      (selType = 3)) Then                                                 'Se item é face, edge ou vertex
                                                     
                                                      Set swComp = SelMgr.GetSelectedObjectsComponent(1)
                                                      PathName = swComp.GetPathName                                       'Caminho do arquivo incl. FileName e extensao
                                                      FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName)) 'Nome do arquivo com extensao
                                                      FileName = VBA.Left(FileName, Len(FileName) - 7)                    'Nome do arquivo sem extensao

                                                  Else
                                                      'Veja se algo está selecionado no FeatureManager
                                                      'Considere todos os itens selecionados
                                                      For i = 1 To SelMgr.GetSelectedObjectCount2(-1) + 1
                                                          'Existe um componente para a seleção?
                                                          Set swComp = SelMgr.GetSelectedObjectsComponent(i)
                                                          If Not swComp Is Nothing Then
                                                              PathName = swComp.GetPathName                                              'Caminho do arquivo incl. FileName e extensor
                                                              FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName))       'Nome do arquivo com extensao
                                                              FileName = VBA.Left(FileName, Len(FileName) - 7)                           'Nome do arquivo sem extensao

                                                              Exit For
                                                          End If
                                                      Next i
                                                  End If
                                              End If
                                             
                                             
                                              If FileName = "" Then
                                                  PathName = swModel.GetPathName                                                          'Caminho do arquivo incl. FileName e extensao
                                              End If
                                                 
                                                  FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName))
                                                  FileName = VBA.Left(FileName, Len(FileName) - 7)                                        'Nome do arquivo sem extensao

                                              DwgName = FileName + ".SLDDRW"
                                                  
                                              If SearchTreeForFile("C:\Geraldo\Data", DwgName, s) Then
                                                  FindFile = Left$(s, InStr(s, vbNullChar) - 1)
                                              End If

                                              'Desenho aberto
                                              Set myDwgDoc = swApp.OpenDoc6(FindFile, swDocDRAWING, swOpenDocOptions_Silent, "", CloseErrors, CloseWarnings)   'O desenho abre
                                            
                                             
                                              ' Verificar se encontrado
                                              If myDwgDoc Is Nothing Then                                                                  'Se nenhum desenho foi encontrado
                                                  Call MsgBox("Desenho não encontrado" & vbCrLf & DwgPath, vbSystemModal, "Atenção")       'Desenho não encontrado
                                              End If
                                             
                                          End Sub

                                            • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                                              Andreas Beck

                                              Hi Geraldo,

                                              please atached the complete Macro here.

                                                • Re: Macro for search .SLDDRW in different folder that .SLDPRT any help me ?
                                                  Geraldo Fernandes

                                                  Sorry Andi. my user not atached permission file... only txt here

                                                   

                                                  ' ------------------------------------------------------------------------------

                                                  Const swDocPART = 1
                                                  Const swDocASSEMBLY = 2
                                                  Const swDocDRAWING = 3
                                                  Const swSelEDGES = 1
                                                  Const swSelFACES = 2
                                                  Const swSelVERTICES = 3

                                                  Public Declare PtrSafe Function _
                                                  ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                                  (ByVal hwnd As Long, _
                                                  ByVal lpOperation As String, _
                                                  ByVal lpFile As String, _
                                                  ByVal lpParameters As String, _
                                                  ByVal lpDirectory As String, _
                                                  ByVal nShowCmd As Long) As Long

                                                  Public Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" ( _
                                                      ByVal RootPath As String, _
                                                      ByVal FileName As String, _
                                                      ByVal OutputPath As String _
                                                    ) As Long

                                                  Dim PathName            As String            'Caminho do arquivo incluido nomes de arquivos e extensao


                                                  Sub Main()

                                                      Dim swApp               As Object
                                                      Dim swModel             As Object           'Documento ativo
                                                      Dim FileName            As String           'Nome do arquivo sem caminho
                                                      Dim txtPathName         As String           'Caminho do arquivo incluido FileName sem extensao
                                                      Dim DwgPath             As String           'Caminho do arquivo incluido FileName e extensao
                                                      Dim DwgName             As String           'O nome do documento ativo com extensao
                                                      Dim myDwgDoc            As Object           'Desenho para abrir
                                                      Dim CloseErrors         As Long             'Para swApp.OpenDoc6
                                                      Dim CloseWarnings       As Long             'Para swApp.OpenDoc6
                                                      Dim SelMgr              As Object
                                                      Dim selType             As Long
                                                      Dim swComp              As Object
                                                      Dim i                   As Long
                                                      Dim s                   As String * 1024
                                                      Dim FindFile            As String
                                                      Dim longstatus          As Long
                                                      Dim longwarnings        As Long

                                                      Set swApp = CreateObject("SldWorks.Application")
                                                      Set swModel = swApp.ActiveDoc                                               'Documento ativo
                                                     
                                                      If swModel Is Nothing Then                                                  'Se nenhum documento estiver aberto,
                                                          Call MsgBox("Nenhum documento aberto!", vbSystemModal, "Atenção")       'Mensagem
                                                          Exit Sub                                                                'e sair
                                                      End If

                                                      If (swModel.GetType = swDocDRAWING) Then                                    'Quando um desenho é aberto,
                                                          Call MsgBox("Um desenho já está aberto!", vbSystemModal, "Atenção")     'Mensagem
                                                          Exit Sub                                                                'e sair
                                                      End If
                                                     
                                                      'Consulta se o documento foi salvo e, se necessário, prompt para salvar
                                                      If swModel.GetPathName = "" Then
                                                          swModel.Save                                                            'Salvar documento ativo como
                                                          End                                                                     'Sair macro
                                                      End If
                                                     

                                                      'Se o assembly, em seguida, verifique se algo está selecionado
                                                      If (swModel.GetType = swDocASSEMBLY) Then
                                                          Set SelMgr = swModel.SelectionManager                                   'Obter a interface SelectionMgr
                                                          selType = SelMgr.GetSelectedObjectType2(1)                              'Verifique o tipo de objeto selecionado
                                                         
                                                         'Se algo for selecionado, defina todas as propriedades desejadas aqui
                                                          If ((selType = 1) Or _
                                                              (selType = 2) Or _
                                                              (selType = 3)) Then                                                 'Se item é face, edge ou vertex
                                                             
                                                              Set swComp = SelMgr.GetSelectedObjectsComponent(1)
                                                              PathName = swComp.GetPathName                                       'Caminho do arquivo incl. FileName e extensao
                                                              FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName)) 'Nome do arquivo com extensao
                                                              FileName = VBA.Left(FileName, Len(FileName) - 7)                    'Nome do arquivo sem extensao

                                                          Else
                                                              'Veja se algo está selecionado no FeatureManager
                                                              'Considere todos os itens selecionados
                                                              For i = 1 To SelMgr.GetSelectedObjectCount2(-1) + 1
                                                                  'Existe um componente para a seleção?
                                                                  Set swComp = SelMgr.GetSelectedObjectsComponent(i)
                                                                  If Not swComp Is Nothing Then
                                                                      PathName = swComp.GetPathName                                              'Caminho do arquivo incl. FileName e extensor
                                                                      FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName))       'Nome do arquivo com extensao
                                                                      FileName = VBA.Left(FileName, Len(FileName) - 7)                           'Nome do arquivo sem extensao

                                                                      Exit For
                                                                  End If
                                                              Next i
                                                          End If
                                                      End If
                                                     
                                                     
                                                      If FileName = "" Then
                                                          PathName = swModel.GetPathName                                                          'Caminho do arquivo incl. FileName e extensao
                                                      End If
                                                         
                                                          FileName = Mid(PathName, InStrRev(PathName, "\") + 1, Len(PathName))
                                                          FileName = VBA.Left(FileName, Len(FileName) - 7)                                        'Nome do arquivo sem extensao

                                                      DwgName = FileName + ".SLDDRW"
                                                          
                                                      If SearchTreeForFile("C:\Geraldo\Data", DwgName, s) Then
                                                          FindFile = Left$(s, InStr(s, vbNullChar) - 1)
                                                      End If

                                                      'Desenho aberto
                                                      Set myDwgDoc = swApp.OpenDoc6(FindFile, swDocDRAWING, swOpenDocOptions_Silent, "", CloseErrors, CloseWarnings)   'O desenho abre
                                                    
                                                     
                                                      ' Verificar se encontrado
                                                      If myDwgDoc Is Nothing Then                                                                  'Se nenhum desenho foi encontrado
                                                          Call MsgBox("Desenho não encontrado" & vbCrLf & DwgPath, vbSystemModal, "Atenção")       'Desenho não encontrado
                                                      End If
                                                     
                                                  End Sub