Yes, my code is changing the creation date of the drawing document to match the date of the last time the drawing file was written to. If you need this scenario changed, that would be easy enough. Do you want change the creation date of both the model document and the drawing document, just the model, or just the drawing? Do you want the creation date within the drawing to directly reference that data from the model document's iProperties (or last file write date), instead of from the drawings own creation/last write date? The "Creation Time" iProperty I specified in my last code is the same one shown within the Project tab of the standard iProperties dialog. Is your title block using that property, or is it using a different Custom iProperty?
Just let me know the exact scenario you want and I'll make it happen for you, even if you want this code to effect both the drawing and the model documents.
Within the last code I posted the following line is where I specified which drawing template file I wanted it to open:
Dim oTFN As String = "S:\Engineering\Templates\A-Size Standard Drawing.idw"
You should change that string after the =, to match the path and file name of the drawing template file you want it to reference your newer title block from.
Also, if you don't need to replace the border, you can delete all that code to simplify the solution for you.
Also, in my last posted code, I specified the name of the Title Block Definition I wanted to copy to my new drawing within this If...Then statement:
For Each oTemTBDef As TitleBlockDefinition In oTemTBDefs
If oTemTBDef.Name = "A-SIZE FULL WIDTH BOTTOM" Then
oNewTBDef = oTemTBDef.CopyTo(oDrDoc, True)
End If
Next
You will need to change "A-SIZE FULL WIDTH BOTTOM" to the name of the title block definition you want within your drawing template file.
Here is an updated code, without the border stuff, and with more iProperty options (some commented out, so you can delete the ones you don't need).
Sub Main
If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
MsgBox("This rule '" & iLogicVb.RuleName & "' only works for Drawing Documents. Exiting.",vbOKOnly+vbCritical, "WRONG DOCUMENT TYPE")
Exit Sub
End If
Dim oDDoc As DrawingDocument = ThisDrawing.Document
ReplaceTB(oDDoc)
Dim oMDoc As Document = ThisDrawing.ModelDocument
' 'drawing only
' oDDoc.PropertySets.Item("Design Tracking Properties").Item("Creation Time").Value = System.IO.File.GetLastWriteTime(oDDoc.FullFileName)
' oDDoc.PropertySets.Item("Design Tracking Properties").Item("Designer").Value = ThisApplication.GeneralOptions.UserName
' 'Model only
' oMDoc.PropertySets.Item("Design Tracking Properties").Item("Creation Time").Value = System.IO.File.GetLastWriteTime(oMDoc.FullFileName)
' oMDoc.PropertySets.Item("Design Tracking Properties").Item("Designer").Value = ThisApplication.GeneralOptions.UserName
'Model data to drawing only
oDDoc.PropertySets.Item("Design Tracking Properties").Item("Creation Time").Value = System.IO.File.GetLastWriteTime(oMDoc.FullFileName)
oDDoc.PropertySets.Item("Design Tracking Properties").Item("Designer").Value = oMDoc.PropertySets.Item("Design Tracking Properties").Item("Designer").Value
End Sub
Sub ReplaceTB(ByRef oDrDoc As DrawingDocument)
Dim oSheets As Sheets = oDrDoc.Sheets
Dim oSheet As Sheet
Dim oTB As TitleBlock
'Delete TitleBlock & Border from each sheet
For Each oSheet In oSheets
oSheet.Activate
oSheet.TitleBlock.Delete
Next
'Re-Activate the first sheet again
oSheets.Item(1).Activate
'Attempt to delete all TitleBlockDefinitions
Dim oTBDefs As TitleBlockDefinitions = oDrDoc.TitleBlockDefinitions
For Each oTBDef As TitleBlockDefinition In oTBDefs
If oTBDef.IsReferenced = False Then
oTBDef.Delete
ElseIf oTBDef.IsReferenced = True Then
MsgBox("Title Block Def Named '" & oTBDef.Name & "' is referenced, and will not be deleted.",vbOKOnly+vbInformation, "CAN'T BE DELETED")
End If
Next
'Specify the Drawing Template document to copy from
Dim oTFN As String = "S:\Engineering\Templates\A-Size Standard Drawing.idw"
Dim oTemplate As DrawingDocument = ThisApplication.Documents.Open(oTFN, False)
Dim oNewTBDef As TitleBlockDefinition
'Copy TitleBlockDefinition from Template to this drawing, and replace if already exists
Dim oTemTBDefs As TitleBlockDefinitions = oTemplate.TitleBlockDefinitions
For Each oTemTBDef As TitleBlockDefinition In oTemTBDefs
If oTemTBDef.Name = "A-SIZE FULL WIDTH BOTTOM" Then
oNewTBDef = oTemTBDef.CopyTo(oDrDoc, True)
End If
Next
'Place the new Border & Title Block on all sheets
For Each oSheet In oSheets
oSheet.Activate
oSheet.AddTitleBlock(oNewTBDef, TitleBlockLocationEnum.kBottomRightPosition)
Next
oTemplate.Close(True)
oTemplate.ReleaseReference
'Re-Activate the first sheet again
oSheets.Item(1).Activate
End Sub
If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click 'LIKE' 👍.
Vote For My IDEAS 💡and Explore My CONTRIBUTIONS
Inventor 2020 Help | Inventor Forum | Inventor Customization Forum | Inventor Ideas Forum
Wesley Crihfield

(Not an Autodesk Employee)