VBA code to iLogic code - run before Save

Anonymous · ‎03-15-2016

Hello,

since we changed to IV16 yesterday, our Autosave VBA-Macro doesnt work.

I know, this is because of the changes made by Autodesk which bans the possibility to use those run before save macros.

So let me first explain what the macro was supposed to do:

It should automatically change the material, the Scale and some texts we use on our IDW drawings.

So since the Macro doesnt run when pressing the save button, i installed the MuM - iLogic run on save AddIn, which seems to be working.

I was able to implement the old code into the iLogic rulebrowser, but, as i expected, the code does not work.

Attached is a screenshot of the errors.

Further I have to say that I have absolutely NO expierence in programming, so i would like to ask if anyone of you will help me with this.

Kind regards, Thomas

Here is the code we used till yesterday with IV13:

Option Explicit


'===========================================================
Private Function EE_FormatScale(ByVal S As Double) As String
  If S >= 1 Then
    If (10 * S Mod 10) = 0 Then
      EE_FormatScale = Format(S, "0") + ":1"
    Else
      EE_FormatScale = Format(S, "0.0") + ":1"
    End If
  Else
    If (10 * (1 / S) Mod 10) = 0 Then
      EE_FormatScale = "1:" + Format(1 / S, "0")
    Else
      EE_FormatScale = "1:" + Format(1 / S, "0.0")
    End If
  End If
End Function

Sub AutoSave()
    Call Massstab
    Call WieGezSpiegelbildlich
    Call WerkstoffZugewiesen
End Sub

Sub WerkstoffZugewiesen()
    
End Sub

Sub WieGezSpiegelbildlich()
On Error Resume Next

    Dim oDoc As Document
    Dim sName As String
    
    'Objekt herstellen
    Set oDoc = ThisApplication.ActiveDocument
    
    sName = Mid(GetFilename(ThisApplication.ActiveDocument.ReferencedDocuments.Item(1).FullDocumentName), 1, Len(ThisApplication.ActiveDocument.ReferencedDocuments.Item(1).FullDocumentName) - 6)
    sName = Mid(sName, 1, 11)
    
    'Füge Zeichenfolge ein
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Bauteilnummer").Value = sName & "01"
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Bauteilnummer gespiegelt").Value = sName & "02"
End Sub

Sub Massstab()
  Dim I, J, K As Integer
  Dim EE_MainScale, EE_TestScale As Double
  Dim EE_SiteScale(10) As Double
  Dim EE_Text As String
  Dim EE_Da As Boolean
  Dim EE_Prop As Property
  Dim oDoc As Document
  Dim EE_Objekt As Object
  
  'Objekt herstellen
  Set oDoc = ThisApplication.ActiveDocument
  
  'Funktioniert nur, wenn Drawing und mindestens eine Ansicht vorhanden ist:
  If oDoc.DocumentType <> kDrawingDocumentObject Then Exit Sub
  If oDoc.ActiveSheet.DrawingViews.Count = 0 Then Exit Sub
  
    'Ermittle die Hauptansicht und Hauptmaßstab
    EE_MainScale = oDoc.ActiveSheet.DrawingViews(1).Scale
  
  'Ermittle weitere Ansichten
  J = 0
  For I = 1 To oDoc.ActiveSheet.DrawingViews.Count
    'Ermittle weitere Maßstäbe
    EE_TestScale = oDoc.ActiveSheet.DrawingViews(I).Scale
    'Prüfe, ob gleich hauptmaßstab
    If EE_TestScale <> EE_MainScale Then
      'Prüfe, ob schon als Nebenmaßstab vorhanden
      If J > 0 Then
        For K = 0 To J
          If EE_TestScale = EE_SiteScale(K) Then
            EE_TestScale = 0
            Exit For
          End If
        Next K
      End If
      If EE_TestScale <> 0 Then
        'Nimm in die Liste auf
        EE_SiteScale(J) = EE_TestScale
        J = J + 1
        'Die liste ist begrenzt...
        If J = 11 Then Exit For
      End If
    End If
  Next I
  
  EE_Text = EE_FormatScale(EE_MainScale)
  If J > 0 Then
    EE_Text = EE_Text + " ("
    For I = 0 To J - 1
      If (I > 0) And (I < 2) Then
        EE_Text = EE_Text + " "
      End If
      If (I > 1) Then
        EE_Text = EE_Text + ", "
      End If
      EE_Text = EE_Text + EE_FormatScale(EE_SiteScale(I))
    Next I
    EE_Text = EE_Text + ")"
  End If

  
  
  'Füge Zeichenfolge ein
  'Maßstab vorhanden?
  EE_Da = False
  For Each EE_Prop In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
    If EE_Prop.Name = "Massstab" Then
      EE_Da = True
      Exit For
    End If
  Next
  If EE_Da Then
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Massstab").Value = EE_Text
  Else
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add EE_Text, "Massstab"
  End If
  
End Sub


Public Function GetFilename(ByVal Path As String) As String
On Error Resume Next

    GetFilename = Mid(Path, Len(GetPath(Path)) + 1, Len(Path) - Len(GetPath(Path)))
End Function


Public Function GetPath(ByVal Pfad As String) As String
On Error Resume Next

    Dim I As Integer
    Dim iPos As Integer
        
    iPos = InStrRev(Pfad, "\", , vbBinaryCompare)
    
    GetPath = Mid(Pfad, 1, iPos)
End Function

Owner2229 · ‎03-15-2016

Hi, try it now:

Option Explicit

Sub Main()
    Call Massstab
    Call WieGezSpiegelbildlich
    Call WerkstoffZugewiesen
End Sub

'===========================================================
Private Function EE_FormatScale(ByVal S As Double) As String
  If S >= 1 Then
    If (10 * S Mod 10) = 0 Then
      EE_FormatScale = Format(S, "0") + ":1"
    Else
      EE_FormatScale = Format(S, "0.0") + ":1"
    End If
  Else
    If (10 * (1 / S) Mod 10) = 0 Then
      EE_FormatScale = "1:" + Format(1 / S, "0")
    Else
      EE_FormatScale = "1:" + Format(1 / S, "0.0")
    End If
  End If
End Function

Sub WerkstoffZugewiesen()
    
End Sub

Sub WieGezSpiegelbildlich()
    On Error Resume Next
    Dim oDoc As Document
    Dim sName As String

    'Objekt herstellen
    oDoc = ThisApplication.ActiveDocument
    
    sName = Mid(GetFilename(oDoc.ReferencedDocuments.Item(1).FullDocumentName), 1, Len(ThisApplication.ActiveDocument.ReferencedDocuments.Item(1).FullDocumentName) - 6)
    sName = Mid(sName, 1, 11)
    
    'Füge Zeichenfolge ein
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Bauteilnummer").Value = sName & "01"
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Bauteilnummer gespiegelt").Value = sName & "02"
End Sub

Sub Massstab()
  Dim I, J, K As Integer
  Dim EE_MainScale, EE_TestScale As Double
  Dim EE_SiteScale(10) As Double
  Dim EE_Text As String
  Dim EE_Da As Boolean
  Dim EE_Prop As Property
  Dim oDoc As Document
  Dim EE_Objekt As Object
  
  'Objekt herstellen
  oDoc = ThisApplication.ActiveDocument
  
  'Funktioniert nur, wenn Drawing und mindestens eine Ansicht vorhanden ist:
  If oDoc.DocumentType <> kDrawingDocumentObject Then Exit Sub
  If oDoc.ActiveSheet.DrawingViews.Count = 0 Then Exit Sub
  
    'Ermittle die Hauptansicht und Hauptmaßstab
    EE_MainScale = oDoc.ActiveSheet.DrawingViews(1).Scale
  
  'Ermittle weitere Ansichten
  J = 0
  For I = 1 To oDoc.ActiveSheet.DrawingViews.Count
    'Ermittle weitere Maßstäbe
    EE_TestScale = oDoc.ActiveSheet.DrawingViews(I).Scale
    'Prüfe, ob gleich hauptmaßstab
    If EE_TestScale <> EE_MainScale Then
      'Prüfe, ob schon als Nebenmaßstab vorhanden
      If J > 0 Then
        For K = 0 To J
          If EE_TestScale = EE_SiteScale(K) Then
            EE_TestScale = 0
            Exit For
          End If
        Next K
      End If
      If EE_TestScale <> 0 Then
        'Nimm in die Liste auf
        EE_SiteScale(J) = EE_TestScale
        J = J + 1
        'Die liste ist begrenzt...
        If J = 11 Then Exit For
      End If
    End If
  Next I
  
  EE_Text = EE_FormatScale(EE_MainScale)
  If J > 0 Then
    EE_Text = EE_Text + " ("
    For I = 0 To J - 1
      If (I > 0) And (I < 2) Then
        EE_Text = EE_Text + " "
      End If
      If (I > 1) Then
        EE_Text = EE_Text + ", "
      End If
      EE_Text = EE_Text + EE_FormatScale(EE_SiteScale(I))
    Next I
    EE_Text = EE_Text + ")"
  End If

  
  
  'Füge Zeichenfolge ein
  'Maßstab vorhanden?
  EE_Da = False
  For Each EE_Prop In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
    If EE_Prop.Name = "Massstab" Then
      EE_Da = True
      Exit For
    End If
  Next
  If EE_Da Then
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Massstab").Value = EE_Text
  Else
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add EE_Text, "Massstab"
  End If
  
End Sub


Public Function GetFilename(ByVal Path As String) As String
    On Error Resume Next
    GetFilename = Mid(Path, Len(GetPath(Path)) + 1, Len(Path) - Len(GetPath(Path)))
End Function


Public Function GetPath(ByVal Pfad As String) As String
    On Error Resume Next
    Dim I As Integer
    Dim iPos As Integer 
    iPos = InStrRev(Pfad, "\", , vbBinaryCompare)
    GetPath = Mid(Pfad, 1, iPos)
End Function

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods

Anonymous · ‎03-17-2016

Hi,

i tried your code, but i didn´t work.

As attachment you find the list of errors.

I tried another way:

Sub Main()
InventorVb.RunMacro("Dokumentprojekt", "Modul1", "WieGezSpiegelbildlich")
InventorVb.RunMacro("Dokumentprojekt", "Modul1", "Massstab")
InventorVb.RunMacro("Dokumentprojekt", "Modul1", "WerkstoffZugewiesen")
End Sub

This worked for a while, but since today it sometimes doesn´t work and says something like

" There is no Module "Modul1" in the active VBA Projekt "Dokumentprojekt" "

Why is it that it works most of the time?

saainsworth · ‎03-17-2016

I'm having the same difficulty. It looks like the ilogic InventorVb.RunMacro cannot decide which document project to use if there is more than one document open. It also matters which order the documents are opened. I believe that the ilogic command is finding the first documentproject in the visual basic project tree and looking for the macro in there. If it does not find it it throws an error.

I do not know the fix for this and I would appreciate insites anyone might have on how to fix this.

saainsworth · ‎03-17-2016

I have found a work around. Rename the DocumentProject in the vba editor to something unique to that template like "DocumentProjectXYZ". Then if other files are open the ilogic command is not fooled by other DocumentProjects <<the default name in all inventor templates. If more than one file that was created from that template is open it does not matter as the VBA code should be the same and it will find it and run it in either of the DocumentProjectXYZ's

Owner2229 · ‎03-17-2016

Hi, you forgot to attach the errors.

You don't have to call the modules by "RunMacro...", they've to be called as modules, you can try this instead:

Sub Main()
    Massstab()
    WieGezSpiegelbildlich()
    WerkstoffZugewiesen()
End Sub

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods

Anonymous · ‎03-17-2016

@Owner2229

Sorry, this page doesn´t work as it is supposed to do with Firefox...

Now it should be in the attachment.

Also i tried your last recommendation, but since our main VBA Project is password protectet, and the one who hast the password will not come back before next week, i am not able to test it.

See the error in attachment.

edit:

@saainsworth

i changed the code to a unique name. We are going to test this a few days. Lets see if it is going to work.

Owner2229 · ‎03-18-2016

Here are the errors corected. Hightlighted so you can see them (on rows 13, 15, 19, 21 and 121). The row 52 didn't need to be there.

Option Explicit

Sub Main()
    Massstab()
    WieGezSpiegelbildlich()
    WerkstoffZugewiesen()
End Sub

'===========================================================
Private Function EE_FormatScale(ByVal S As Double) As String
  If S >= 1 Then
    If (10 * S Mod 10) = 0 Then
      EE_FormatScale = Microsoft.VisualBasic.Strings.Format(S, "0") + ":1"
    Else
      EE_FormatScale = Microsoft.VisualBasic.Strings.Format(S, "0.0") + ":1"
    End If
  Else
    If (10 * (1 / S) Mod 10) = 0 Then
      EE_FormatScale = "1:" + Microsoft.VisualBasic.Strings.Format(1 / S, "0")
    Else
      EE_FormatScale = "1:" + Microsoft.VisualBasic.Strings.Format(1 / S, "0.0")
    End If
  End If
End Function

Sub WerkstoffZugewiesen()
    
End Sub

Sub WieGezSpiegelbildlich()
    On Error Resume Next
    Dim oDoc As Document
    Dim sName As String

    'Objekt herstellen
    oDoc = ThisApplication.ActiveDocument
    
    sName = Mid(GetFilename(oDoc.ReferencedDocuments.Item(1).FullDocumentName), 1, Len(ThisApplication.ActiveDocument.ReferencedDocuments.Item(1).FullDocumentName) - 6)
    sName = Mid(sName, 1, 11)
    
    'Füge Zeichenfolge ein
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Bauteilnummer").Value = sName & "01"
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Bauteilnummer gespiegelt").Value = sName & "02"
End Sub

Sub Massstab()
  Dim I, J, K As Integer
  Dim EE_MainScale, EE_TestScale As Double
  Dim EE_SiteScale(10) As Double
  Dim EE_Text As String
  Dim EE_Da As Boolean
  Dim EE_Prop As Property
  Dim oDoc As Document
  
  'Objekt herstellen
  oDoc = ThisApplication.ActiveDocument
  
  'Funktioniert nur, wenn Drawing und mindestens eine Ansicht vorhanden ist:
  If oDoc.DocumentType <> kDrawingDocumentObject Then Exit Sub
  If oDoc.ActiveSheet.DrawingViews.Count = 0 Then Exit Sub
  
    'Ermittle die Hauptansicht und Hauptmaßstab
    EE_MainScale = oDoc.ActiveSheet.DrawingViews(1).Scale
  
  'Ermittle weitere Ansichten
  J = 0
  For I = 1 To oDoc.ActiveSheet.DrawingViews.Count
    'Ermittle weitere Maßstäbe
    EE_TestScale = oDoc.ActiveSheet.DrawingViews(I).Scale
    'Prüfe, ob gleich hauptmaßstab
    If EE_TestScale <> EE_MainScale Then
      'Prüfe, ob schon als Nebenmaßstab vorhanden
      If J > 0 Then
        For K = 0 To J
          If EE_TestScale = EE_SiteScale(K) Then
            EE_TestScale = 0
            Exit For
          End If
        Next K
      End If
      If EE_TestScale <> 0 Then
        'Nimm in die Liste auf
        EE_SiteScale(J) = EE_TestScale
        J = J + 1
        'Die liste ist begrenzt...
        If J = 11 Then Exit For
      End If
    End If
  Next I
  
  EE_Text = EE_FormatScale(EE_MainScale)
  If J > 0 Then
    EE_Text = EE_Text + " ("
    For I = 0 To J - 1
      If (I > 0) And (I < 2) Then
        EE_Text = EE_Text + " "
      End If
      If (I > 1) Then
        EE_Text = EE_Text + ", "
      End If
      EE_Text = EE_Text + EE_FormatScale(EE_SiteScale(I))
    Next I
    EE_Text = EE_Text + ")"
  End If

  
  
  'Füge Zeichenfolge ein
  'Maßstab vorhanden?
  EE_Da = False
  For Each EE_Prop In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}") 'Benutzerdefiniert
    If EE_Prop.Name = "Massstab" Then
      EE_Da = True
      Exit For
    End If
  Next
  If EE_Da Then
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Massstab").Value = EE_Text
  Else
    oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add(EE_Text, "Massstab")
  End If
  
End Sub


Public Function GetFilename(ByVal Path As String) As String
    On Error Resume Next
    GetFilename = Mid(Path, Len(GetPath(Path)) + 1, Len(Path) - Len(GetPath(Path)))
End Function


Public Function GetPath(ByVal Pfad As String) As String
    On Error Resume Next
    Dim I As Integer
    Dim iPos As Integer 
    iPos = InStrRev(Pfad, "\", , vbBinaryCompare)
    GetPath = Mid(Pfad, 1, iPos)
End Function

Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods

rossano_praderi · ‎03-22-2016

You can also use my opensource Addin which enable the vba autoruns functionalities (you doesn't need to change your macro).

Look at my signature.

Bregs
Rossano Praderi

--------------------------------------
If my post answers your question, please click the "Accept as Solution"
button. This helps everyone find answers more quickly!
---------------

Anonymous · ‎03-22-2016

@ Owner2229

It seems that your code is working, there were no more errors.

So thanks for your help, and of course, thanks for every other suggestion.

Community

VBA code to iLogic code - run before Save

VBA code to iLogic code - run before Save

VBA code to iLogic code - run before Save