Scale to iproperty

[Anonymous]

Hi

Can someone explain me, how to export the drawing scale to a custom property, I can use in my title block? I would prefer that it updates when you save.

I use Inventor 2012 64bit.

I hope someone can help

Best regard

Kim Christoffersen

[alewer]

Try the following macro:

Public Sub ScaleToProp()
  On Error Resume Next
  'Get the drawing document
  Dim oDrawingDoc As Inventor.DrawingDocument
  Set oDrawingDoc = ThisApplication.ActiveDocument
  Dim oErrResponse As VbMsgBoxResult
  If Err Then
    oErrResponse = MsgBox("Active document must be a drawing", vbExclamation, "Error")
    Exit Sub
  End If
  
  'Get the first sheet
  Dim oSheet As Inventor.Sheet
  Set oSheet = oDrawingDoc.Sheets.Item(1)
  
  'Get the first view
  Dim oView As Inventor.DrawingView
  Set oView = oSheet.DrawingViews.Item(1)
  If Err Then
    oErrResponse = MsgBox("Drawing has no views", vbExclamation, "Error")
    Exit Sub
  End If
  
  'Get the view scale string
  Dim sViewScale As String
  sViewScale = oView.ScaleString
  
  'Get the custom propertyset
  Dim oCustomPropSet As Inventor.PropertySet
  Set oCustomPropSet = oDrawingDoc.PropertySets.Item("Inventor User Defined Properties")
  
  'Get the "Scale" custom iproperty.  If it doesn't exist, we'll create it
  Dim oScaleProp As Inventor.Property
  Set oScaleProp = oCustomPropSet.Item("Scale")
  If Err Then
    Set oScaleProp = oCustomPropSet.Add("", "Scale")
  End If
  oScaleProp.Value = sViewScale
  
  'Update the drawing.  This will update the title block scale
  oDrawingDoc.Update
End Sub

If it doesn't exist, this creates a custom iproperty named "Scale" whos value is the scale string from the first sheet's first view.  Let me know if this works for you.

[Anonymous]

Thanks for the quick answer.

Can you describe how i use this macro? Where shall I place it?

Br

Kim C

[alewer]

Search the Inventor helpfiles for "macro."  I'm running 2010 with the classic interface, so I can't give you step-by-step instructions for 2012.  Let me know if you get hung up at any point in the helpfile instructions and I'll do my best to help out.

[Anonymous]

It works in the WBA editor, when I activate the "play" button.

Is it posible to set this up, so that the script is activated when the "save" button is activated.

[PACDrafting · Accepted solution]

You can put the code into ilogic. Just needed a bit of a touchup to suit VB.Net.

Once you have added the code, go to Event Triggers which is located under the Manage TAB in the ribbin panel and add this code to After Save.

 
Public Sub Main()
  On Error Resume Next
  'Get the drawing document
  Dim oDrawingDoc As Inventor.DrawingDocument
  oDrawingDoc = ThisApplication.ActiveDocument
  'Dim oErrResponse As VbMsgBoxResult
  If Err.number <> 0 Then
    MsgBox("Active document must be a drawing", vbExclamation, "Error")
    Exit Sub
  End If
  
  'Get the first sheet
  Dim oSheet As Inventor.Sheet
  oSheet = oDrawingDoc.Sheets.Item(1)
  
  'Get the first view
  Dim oView As Inventor.DrawingView
  oView = oSheet.DrawingViews.Item(1)
  If Err.number <> 0 Then
    MsgBox("Drawing has no views", vbExclamation, "Error")
    Exit Sub
  End If
  
  'Get the view scale string
  Dim sViewScale As String
  sViewScale = oView.ScaleString
  
  'Get the custom propertyset
 Dim oCustomPropSet As Inventor.PropertySet
 oCustomPropSet = oDrawingDoc.PropertySets.Item("Inventor User Defined Properties")
  
  'Get the "Scale" custom iproperty.  If it doesn't exist, we'll create it
  Dim oScaleProp As Inventor.Property
  oScaleProp = oCustomPropSet.Item("Scale")
  If Err.number <> 0 Then
  oScaleProp = oCustomPropSet.Add("", "Scale")
  End If
  oScaleProp.Value = sViewScale
  
  'Update the drawing.  This will update the title block scale
  oDrawingDoc.Update
End Sub

[Anonymous]

THANKS! Worked perfectly!