19.9.22

Update Drawing Title Block

This rule replaces old title block with new title block in all sheets in drawing.

In parameter "titleTemplatePath" set  drawing template path. 

This template need to contain new title block definition. 

Name of this title block definition set in parameter "titleName".



Procedure:

- detect document type

- search all drawing sheets, and removing all title blocks

- removing all title blocks and sheets formats in drawing resources

- activating new title block

Code:

Sub Main()

Dim oDoc As Document
oDoc = ThisDoc.Document
Dim titleTemplatePath As String = "\\Templates\NewDrawing.idw"
Dim titleName As String = "NewTitle"

If oDoc.DocumentType = Inventor.DocumentTypeEnum.kDrawingDocumentObject Then 
	Dim oDrawDoc As DrawingDocument
	
	oDrawDoc = ThisApplication.ActiveDocument	
	ThisDrawing.ResourceFileName = titleTemplatePath 		
ClearAllSheets(oDrawDoc, titleName) ClearTitles(oDrawDoc) ActivateTitle(oDrawDoc, titleName) Else MessageBox.Show("This is not drawing!", "Info") End If End Sub Sub ClearAllSheets(oDoc As DrawingDocument, titleName As String)
	For Each item In oDoc.Sheets
		item.Activate
		ClearDrawingsSheetsSource(oDoc) 		
		DeleteActivTitleBlock(oDoc)	
	Next
End Sub


Sub ActivateTitle(oDoc As DrawingDocument, titleName As String)
	For Each item In oDoc.Sheets
		item.Activate
		ActiveSheet.TitleBlock = titleName
	Next
End Sub


Sub ClearDrawingsSheetsSource(oDoc As DrawingDocument)
Dim oSheetformats As SheetFormats
oSheetformats = oDoc.SheetFormats

Dim oSheetFormat As SheetFormat
For Each oSheetFormat In oSheetformats
    oSheetFormat.Delete
Next

End Sub

Sub DeleteActivTitleBlock(oDoc As DrawingDocument)
	Dim oTitleBlock As TitleBlock
	oTitleBlock = oDoc.ActiveSheet.TitleBlock	
	Try
		oTitleBlock.Delete
	Catch 
	End Try
End Sub


Sub ClearTitles(oDoc As DrawingDocument)

Dim oTitleBlocks As TitleBlockDefinitions
oTitleBlocks = oDoc.TitleBlockDefinitions
Dim oTitleBlock As TitleBlockDefinition
For Each oTitleBlock In oTitleBlocks
	oTitleBlock.Delete	
Next

End Sub


Sub LoadTitleBlock(titleTemplatePath  As String, titleName As String)
ThisDrawing.ResourceFileName = titleTemplatePath
End Sub

Žádné komentáře:

Okomentovat