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
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