Stile aktualisieren (Autodesk/Inventor VBA)

Hab das auch erst im Dezember bei uns eingebaut =):

Code:
Sub IDW_UpdateStylesIV2008()
'check if the active document is a drawing document
If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
Dim oIDW As DrawingDocument
Set oIDW = ThisApplication.ActiveDocument
Dim oIDWStyles As Inventor.DrawingStylesManager
Set oIDWStyles = oIDW.StylesManager
Else
MsgBox "Nur in einer Zeichnung möglich!", vbExclamation
Exit Sub
End If

Dim i As Integer
Dim k As Integer
For k = 1 To 3
'loop thru all styles and check if they are up to date
For i = 1 To oIDWStyles.StandardStyles.Count
'Debug.Print "Std Styles - " & i & " - " & oIDWStyles.StandardStyles.item(i).name
If oIDWStyles.StandardStyles.item(i).UpToDate = False Then
oIDWStyles.StandardStyles.item(i).UpdateFromGlobal
End If
If oIDWStyles.StandardStyles.item(i).InUse = False Then 'Wenn nicht in verwendung
'Debug.Print "Delete: " & i & " - " & oIDWStyles.StandardStyles.item(i).name 'name debug ausgeben
On Error Resume Next 'Ist nötig da stil meist nicht gelöscht werden kann obwohl nicht in verwendung
oIDWStyles.StandardStyles.item(i).DELETE 'Löscht stil
On Error GoTo 0
End If
Next

For i = 1 To oIDWStyles.ObjectDefaultsStyles.Count
'Debug.Print "Obj Def Styles - " + oIDWStyles.ObjectDefaultsStyles.Item(I).Name
If oIDWStyles.ObjectDefaultsStyles.item(i).UpToDate = False Then
oIDWStyles.ObjectDefaultsStyles.item(i).UpdateFromGlobal
End If
If oIDWStyles.ObjectDefaultsStyles.item(i).InUse = False Then 'Wenn nicht in verwendung
'Debug.Print oIDWStyles.ObjectDefaultsStyles.item(i).name 'name debug ausgeben
On Error Resume Next
oIDWStyles.ObjectDefaultsStyles.item(i).DELETE 'Löscht
On Error GoTo 0
End If
Next

For i = 1 To oIDWStyles.DimensionStyles.Count
On Error Resume Next
'Debug.Print "Dim Styles - " + oIDWStyles.DimensionStyles.item(i).name
If oIDWStyles.DimensionStyles.item(i).UpToDate = False Then
oIDWStyles.DimensionStyles.item(i).UpdateFromGlobal
End If
'Debug.Print 'DimensionStyles ' & oIDWStyles.DimensionStyles.item(i).name 'name debug ausgeben
If oIDWStyles.DimensionStyles.item(i).InUse = False Then 'Wenn nicht in verwendung
oIDWStyles.DimensionStyles.item(i).DELETE 'Löscht stil
End If
On Error GoTo 0
Next

For i = 1 To oIDWStyles.TextStyles.Count
On Error Resume Next
'Debug.Print "TXT Styles - " + oIDWStyles.TextStyles.Item(I).Name
If oIDWStyles.TextStyles.item(i).UpToDate = False Then
oIDWStyles.TextStyles.item(i).UpdateFromGlobal
End If
If oIDWStyles.TextStyles.item(i).InUse = False Then 'Wenn nicht in verwendung
'Debug.Print oIDWStyles.TextStyles.item(i).name 'name debug ausgeben
oIDWStyles.TextStyles.item(i).DELETE 'Löscht stil
End If
On Error GoTo 0
Next

For i = 1 To oIDWStyles.Layers.Count
On Error Resume Next
'Debug.Print "Layers Styles - " + oIDWStyles.Layers.Item(I).Name
If oIDWStyles.Layers.item(i).UpToDate = False Then
oIDWStyles.Layers.item(i).UpdateFromGlobal
End If
If oIDWStyles.Layers.item(i).InUse = False Then 'Wenn nicht in verwendung
'Debug.Print oIDWStyles.Layers.item(i).name 'name debug ausgeben
oIDWStyles.Layers.item(i).DELETE 'Löscht stil
End If
On Error GoTo 0
Next

'Inv2008 Styles Class
For i = 1 To oIDWStyles.Styles.Count
On Error Resume Next
'Debug.Print "Styles - " + oIDWStyles.Styles.item(i).name
If oIDWStyles.Styles.item(i).UpToDate = False Then
oIDWStyles.Styles.item(i).UpdateFromGlobal
End If
If oIDWStyles.Styles.item(i).InUse = False Then 'Wenn nicht in verwendung
'Debug.Print oIDWStyles.Styles.item(i).name 'name debug ausgeben
oIDWStyles.Styles.item(i).DELETE 'Löscht stil
End If
On Error GoTo 0
Next
Next

oIDW.Update
'oIDW.Save
'set Drawing settings
'If oIDW.DrawingSettings.DeferUpdates = True Then
' oIDW.DrawingSettings.DeferUpdates = False
'oIDW.Save
'End If
'oIDW.Close
End Sub

------------------
Grüße aus Wien
Philipp
Email: Base64 Encoded:
cGhpcHNfOTJAeWFob28uZGU=

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

pitCAD Ultimate Lüftung - Klima Netzwerk CAD APP für TGA, Elektro, Facility Management