Ok so I have searched and managed to put a few different Ilogics together.
Firstly I open an old drawing and delete unused drawing resources then run the ilogic.
It seems to do what I would like except I have to run the ilogic twice to purge old styles.
Things id like to try add:
1. Delete un used drawing resources in old drawing
2. Id like to get it to copy the sheet formats as well
3. Fix the need to run it twice to purge styles completly
Thanks
Option Explicit
Imports System.Windows.Forms
Dim oTargetDoc, oSourceDoc As DrawingDocument
Dim oTBdef As TitleBlockDefinition
Dim oTBdefs As TitleBlockDefinitions
Dim oBorderDef As BorderDefinition
Dim oBorderDefs As BorderDefinitions
Dim oSymbol As SketchedSymbolDefinition
Dim oSymbols As SketchedSymbolDefinitions
Dim oPrompt As String
If ThisDoc.Document.DocumentType <> kDrawingDocumentObject Then
MsgBox("This rule may only be run on drawing documents!",vbOKOnly,"Update Titleblocks")
Exit Sub
End If
oTargetDoc = ThisDrawing.Document
oPrompt = MsgBox("Update Titleblocks and Styles?",vbYesNo,"Update Titleblocks")
Select Case oPrompt
Case vbNo
Exit Sub
Case vbYes
oSourceDoc = ThisApplication.Documents.Open("C:\_Vault\WS\Standards\Inventor Templates\Standard.idw", False)
oTargetDoc.StylesManager.ActiveStandardStyle.UpdateFromGlobal
End Select
oTBdefs = oSourceDoc.TitleBlockDefinitions
oBorderDefs = oSourceDoc.BorderDefinitions
oSymbols = oSourceDoc.SketchedSymbolDefinitions
For Each oTBdef In oTBdefs
Try
If oTBdef.Name <> "ANSI - Large" Then
oTBdef.CopyTo(oTargetDoc, True)
End If
Catch
MsgBox("Unknown error in copy title block for " & Chr(34) & oTBdef.Name & Chr(34),vbOKOnly,"Error")
End Try
Next
For Each oBorderDef In oBorderDefs
Try
If oBorderDef.Name <> "Default Border" Then
oBorderDef.CopyTo(oTargetDoc, True)
End If
Catch
MsgBox("Unknown error in copy border definition for " & Chr(34) & oBorderDef.Name & Chr(34),vbOKOnly,"Error")
End Try
Next
For Each oSymbol In oSymbols
Try
oSymbol.CopyTo(oTargetDoc, True)
Catch
MsgBox("Unknown error in copy sketched symbol for " & Chr(34) & oSymbol.Name & Chr(34),vbOKOnly,"Error")
End Try
Next
'Set Styles Standard to suit Template
Const kStandardName = "Company Standards"
Const kObjDefaultsName = "My Defaults"
Dim oDoc As DrawingDocument
oDoc = ThisApplication.ActiveDocument
Dim oStylesMgr As DrawingStylesManager
oStylesMgr = oDoc.StylesManager
Dim oStandard As DrawingStandardStyle
oStandard = oStylesMgr.StandardStyles _
.Item(kStandardName)
If oStandard Is Nothing Then
oStandard = oStylesMgr.StandardStyles _
.Item(1).Copy(kStandardName)
End If
oStylesMgr.ActiveStandardStyle = oStandard
'Update Sytles
Dim oCM As CommandManager = ThisApplication.CommandManager
Dim oCD As ControlDefinitions = oCM.ControlDefinitions
Dim oUpdateStyles As ControlDefinition = oCD.Item("UpdateStylesCmd")
oUpdateStyles.Execute2(False)
SendKeys.SendWait("Y ")
'Purge Styles
Dim doc As Document = ThisApplication.ActiveDocument
If (doc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject) Then
Dim dDoc As DrawingDocument = doc
Dim styles As styles = dDoc.StylesManager.Styles
For Each styl As Style In styles
If (styl.InUse = False And styl.StyleLocation <> StyleLocationEnum.kLibraryStyleLocation) Then
styl.Delete()
End If
Next
ElseIf (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject Or doc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject) Then
For Each Asset As Asset In doc.Assets
If (Asset.IsUsed = False) Then
If (Asset.AssetType = AssetTypeEnum.kAssetTypeMaterial Or
Asset.AssetType = AssetTypeEnum.kAssetTypeAppearance) Then
Asset.Delete()
End If
End If
Next
End If
'---Execute twice---
If (doc.DocumentType = DocumentTypeEnum.kDrawingDocumentObject) Then
Dim dDoc As DrawingDocument = doc
Dim styles As styles = dDoc.StylesManager.Styles
For Each styl As Style In styles
If (styl.InUse = False And styl.StyleLocation <> StyleLocationEnum.kLibraryStyleLocation) Then
styl.Delete()
End If
Next
ElseIf (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject Or doc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject) Then
For Each Asset As Asset In doc.Assets
If (Asset.IsUsed = False) Then
If (Asset.AssetType = AssetTypeEnum.kAssetTypeMaterial Or
Asset.AssetType = AssetTypeEnum.kAssetTypeAppearance) Then
Asset.Delete()
End If
End If
Next
End If