AnsweredAssumed Answered

Out of memory. Multiple instances of a macro open

Question asked by Danilo Martins on May 30, 2016

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

Outcomes