0 Replies Latest reply on May 30, 2016 9:48 AM by Danilo Martins

    Out of memory. Multiple instances of a macro open

    Danilo Martins

      I created a macro an saved it in the part file, so a equation calls it on every rebuild.

      But thats my new problem, since it calls my macro on every rebuild, it remains opened! When I try to edit a macro I see a lot of instances of the macro that the equation calls opened, and consuming all my memory.

       

      Actually I don't need that this macro runs on every rebuild. Its ok if it runs just when my file was saved, but my tries to do that doesn't works on every save. And if it don't run it can cause me serious problems.

       

      Below my current macro. Any help?

       

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

       

      Option Explicit

       

          Dim swApp               As SldWorks.SldWorks

          Dim swModel             As SldWorks.ModelDoc2

          Dim swConfigMgr         As SldWorks.ConfigurationManager

          Dim swConfig            As SldWorks.Configuration

          Dim swCustPropMgr       As SldWorks.CustomPropertyManager

       

       

          Dim valOut              As String

          Dim TIPO      As String

         

          Dim retval As Boolean

         

          Dim ALTURA As Variant

          Dim LARGURA As Variant

          Dim COMPRIMENTO As Variant

          Dim MEDIDA1 As Variant

          Dim MEDIDA2 As Variant

          Dim MEDIDA3 As Variant

          Dim DIAMETRO As Variant

          Dim CANTOS As Variant

       

      Sub main()

       

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

          Set swConfigMgr = swModel.ConfigurationManager

          Set swConfig = swConfigMgr.ActiveConfiguration

          'Debug.Print "Name of this configuration:" & swConfig.Name

       

          Set swCustPropMgr = swConfig.CustomPropertyManager

       

       

          swCustPropMgr.Get2 "TIPO", valOut, TIPO

          'MsgBox TIPO

             

      If TIPO = "MANUAL" Or TIPO = "PERFIL" Then 'ENCERRAR PREENCHIMENTO AUTOMÁTICO

          End

      End If

       

       

      If TIPO <> "TRABALHADO" And TIPO <> "CHAPA" And TIPO <> "EIXO" And TIPO <> "BRUTO" And TIPO <> "TORNEADO" And TIPO <> "BARRA QUADRADA" And TIPO <> "BARRA REDONDA" Then

          MsgBox "Tipo de fabricação não conhecido." + vbCrLf + _

                  "Preencha o TIPO como uma das opções:" + vbCrLf + _

                  "TRABALHADO, TORNEADO, CHAPA, EIXO, BRUTO, BARRA QUADRADA ou BARRA REDONDA" + vbCrLf + vbCrLf + _

                  "Ou preecha com MANUAL para escrever manualmente conforme necessário"

          End

      End If

       

      'MsgBox TIPO

       

      'LER MEDIDAS

      CANTOS = swModel.GetPartBox(True)         'True comes back as system units - meters

       

      ALTURA = Round((Abs(CANTOS(4) - CANTOS(1)) * 1000), 2) ' Z axis

      LARGURA = Round((Abs(CANTOS(5) - CANTOS(2)) * 1000), 2)  ' Y axis

      COMPRIMENTO = Round((Abs(CANTOS(3) - CANTOS(0)) * 1000), 2) ' X axis

       

      'ORDENAR AS DIMENSOES

      If ALTURA > LARGURA Then

          If ALTURA > COMPRIMENTO Then

              MEDIDA1 = ALTURA

              If LARGURA > COMPRIMENTO Then

              MEDIDA2 = LARGURA

              MEDIDA3 = COMPRIMENTO

              Else

              MEDIDA2 = COMPRIMENTO

              MEDIDA3 = LARGURA

              End If

          Else

              MEDIDA1 = COMPRIMENTO

              MEDIDA2 = ALTURA

              MEDIDA3 = LARGURA

          End If

      Else

          If COMPRIMENTO > LARGURA Then

              MEDIDA1 = COMPRIMENTO

              MEDIDA2 = LARGURA

              MEDIDA3 = ALTURA

          Else

              MEDIDA1 = LARGURA

              MEDIDA2 = ALTURA

              MEDIDA3 = COMPRIMENTO

          End If

      End If

       

      'MsgBox MEDIDA1 & " x " & MEDIDA2 & " x " & MEDIDA3 'MOSTRAR MEDIDAS

       

      'If TIPO <> "MANUAL" Then

          swCustPropMgr.Delete "DIMENSIONAL"

      'End If

       

      'PREENCHER DE ACORDO COM TIPO

      If TIPO = "TRABALHADO" Then

          retval = swCustPropMgr.Add2("DIMENSIONAL", swCustomInfoText, _

                  "t. " & MEDIDA3 & " x " & MEDIDA2 & " x " & MEDIDA1)

       

      ElseIf TIPO = "CHAPA" Then

          retval = swCustPropMgr.Add2("DIMENSIONAL", swCustomInfoText, _

                   "ch. " & MEDIDA3 & " x " & MEDIDA2 & " x " & MEDIDA1)  'ESCREVER VALORES

       

      ElseIf TIPO = "EIXO" Then

          If MEDIDA1 = MEDIDA2 Then

                  DIAMETRO = MEDIDA1

                  COMPRIMENTO = MEDIDA3

              ElseIf MEDIDA2 = MEDIDA3 Then

                  DIAMETRO = MEDIDA2

                  COMPRIMENTO = MEDIDA1

              ElseIf MEDIDA1 = MEDIDA3 Then

                  DIAMETRO = MEDIDA3

                  COMPRIMENTO = MEDIDA2

          End If

          retval = swCustPropMgr.Add2("DIMENSIONAL", swCustomInfoText, _

                   "Ø" & DIAMETRO & " x " & COMPRIMENTO)  'ESCREVER VALORES

                  

      ElseIf TIPO = "BRUTO" Then

          retval = swCustPropMgr.Add2("DIMENSIONAL", swCustomInfoText, _

                   "Br. " & MEDIDA3 & " x " & MEDIDA2 & " x " & MEDIDA1)  'ESCREVER VALORES

                  

      ElseIf TIPO = "BARRA QUADRADA" Then

          retval = swCustPropMgr.Add2("DIMENSIONAL", swCustomInfoText, _

                   "barra " & MEDIDA3 & " x " & MEDIDA2 & " x " & MEDIDA1)  'ESCREVER VALORES

                  

      ElseIf TIPO = "BARRA REDONDA" Then

          If MEDIDA1 = MEDIDA2 Then

                  DIAMETRO = MEDIDA1

                  COMPRIMENTO = MEDIDA3

              ElseIf MEDIDA2 = MEDIDA3 Then

                  DIAMETRO = MEDIDA2

                  COMPRIMENTO = MEDIDA1

              ElseIf MEDIDA1 = MEDIDA3 Then

                  DIAMETRO = MEDIDA3

                  COMPRIMENTO = MEDIDA2

          End If

          retval = swCustPropMgr.Add2("DIMENSIONAL", swCustomInfoText, _

                   "barra Ø" & DIAMETRO & " x " & COMPRIMENTO)  'ESCREVER VALORES

                  

      ElseIf TIPO = "TORNEADO" Then

          If MEDIDA1 = MEDIDA2 Then

                  DIAMETRO = MEDIDA1

                  COMPRIMENTO = MEDIDA3

              ElseIf MEDIDA2 = MEDIDA3 Then

                  DIAMETRO = MEDIDA2

                  COMPRIMENTO = MEDIDA1

              ElseIf MEDIDA1 = MEDIDA3 Then

                  DIAMETRO = MEDIDA3

                  COMPRIMENTO = MEDIDA2

          End If

          retval = swCustPropMgr.Add2("DIMENSIONAL", swCustomInfoText, _

                   "t. Ø" & DIAMETRO & " x " & COMPRIMENTO)  'ESCREVER VALORES

      Else

          'MsgBox "TIPO """ & TIPO & """ NÃO CADASTRADO PARA PREENCHIMENTO DO DIMENSIONAL AUTOMÁTICO."

       

      End If

            

      End Sub