Message 1 of 4
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
Currently I am using the Ilogic code below to update the parts list on old drawings when they are saved or copied. The designer on the drawing is also updated when the drawing is saved.
However, I also made a few changes to the parts list style. I would like this code to also update the document styles, then remove the parts list and then add the parts list (same type!) again.
Unfortunately it won't work without removing the parts list. I tested this manually. Apparently Inventor does not update the parts list until it has been removed.
Could someone possibly help me with this?
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
Dim oDoc As Document = ThisDoc.Document
Dim oLastCreationDate as Date = oDDoc.PropertySets.Item("Design Tracking Properties").Item("Creation Time").value
'msgbox(oLastCreationDate)
'Set the oldest allowable date to leave the title block alone.
Dim oOldDate As Date = DateValue("10/05/2022") ' this will often accept many formats that can be understood as representing a date.
Dim lValue as string = Format(Now, "dd/MM/yy")
'msgbox(lvalue)
'Comparing dates
'MsgBox("Older date compared to newer date = " & oLastCreationDate.CompareTo(oOldDate)) 'should equal 1, because oLastCreationDate is later than oOldDate
if oLastCreationDate.CompareTo(oOldDate) = -1 then
ReplaceTB(oDDoc)
Dim oMDoc As Document = ThisDrawing.ModelDocument
' 'drawing only
end if
oDDoc.PropertySets.Item("Design Tracking Properties").Item("Creation Time").Value = lValue
oDDoc.PropertySets.Item("Design Tracking Properties").Item("Designer").Value = ThisApplication.GeneralOptions.UserName
end Sub
function 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 = "C:\WF\System Configurations\2020\Inventor\Templates\Template Notech V1.0.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 = "Notech" 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 function
Kind regards,
Jeffrey
Solved! Go to Solution.