Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
mgeeW7SQV
in reply to: mgeeW7SQV

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