Thanks again Stakin,
Would you be able to help me with this new section of the code? I have added the option to set the date as well. The user has three options. If you can't help I will post it. Thanks either way!
"msg = "What would you like to do for '" & propName & "'?" & vbCrLf & _
"1 - Set to today's date (" & todayStr & ")" & vbCrLf & _
"2 - Leave existing date as-is" & vbCrLf & _
"3 - Enter a new date (use your computer's format: " & todayStr & ")""
The code runs and allows you to choose any of the three options and finishes up without error. It just does not change the dates.
How can I find the names of items like this? Is there a tool that allows me to watch the commands and how they execute within Inventor?
Sub Tb_Fill()
Dim oDoc As Document
Dim dwg_rev As String, ckr As String, apr As String, drn As String
Dim currentRev As String, currentCkr As String, currentApr As String, currentAuthor As String, currentDesigner As String
Dim propSetSummary As PropertySet, propSetTracking As PropertySet, propSetCustom As PropertySet
Dim localDate As String: localDate = Format(Date, "Short Date")
' Ensure an active document is open
If ThisApplication.ActiveDocument Is Nothing Then
MsgBox "No active document open!", vbExclamation, "Error"
Exit Sub
End If
Set oDoc = ThisApplication.ActiveDocument
' Ensure it's a drawing document
If oDoc.DocumentType <> kDrawingDocumentObject Then
MsgBox "Active document is not a drawing file!", vbExclamation, "Error"
Exit Sub
End If
' Get property sets
On Error Resume Next
Set propSetSummary = oDoc.PropertySets.Item("Inventor Summary Information")
Set propSetTracking = oDoc.PropertySets.Item("Design Tracking Properties")
Set propSetCustom = oDoc.PropertySets.Item("Inventor User Defined Properties")
On Error GoTo 0
If propSetSummary Is Nothing Or propSetTracking Is Nothing Or propSetCustom Is Nothing Then
MsgBox "Unable to access required property sets.", vbCritical, "Error"
Exit Sub
End If
' Get current values
On Error Resume Next
currentRev = propSetSummary.Item("Revision Number").Value
currentAuthor = propSetSummary.Item("Author").Value
currentDesigner = propSetTracking.Item("Designer").Value
currentCkr = propSetTracking.Item("Checked By").Value
currentApr = propSetTracking.Item("Engr Approved By").Value
On Error GoTo 0
' Prompt inputs
dwg_rev = Trim(InputBox("Enter Revision Number (leave blank to skip):", "Revision", currentRev))
If dwg_rev <> "" Then
SetOrAdd propSetSummary, "Revision Number", dwg_rev
' No date prompt for revision
End If
drn = Trim(InputBox("Enter Author/Designer Name (leave blank to skip):", "Author/Designer", currentAuthor))
If drn <> "" Then
SetOrAdd propSetSummary, "Author", drn
SetOrAdd propSetTracking, "Designer", drn
HandleDatePrompt propSetCustom, "Creation Date", localDate
End If
ckr = Trim(InputBox("Enter Checker Name (leave blank to skip):", "Checker", currentCkr))
If ckr <> "" Then
SetOrAdd propSetTracking, "Checked By", ckr
HandleDatePrompt propSetCustom, "checked date", localDate
End If
apr = Trim(InputBox("Enter Approver Name (leave blank to skip):", "Approver", currentApr))
If apr <> "" Then
SetOrAdd propSetTracking, "Engr Approved By", apr
HandleDatePrompt propSetCustom, "Engr Approved Date", localDate
End If
MsgBox "iProperties updated (only filled fields).", vbInformation, "Done"
End Sub
Sub SetOrAdd(propSet As PropertySet, propName As String, val As String)
On Error Resume Next
propSet.Item(propName).Value = val
If Err.Number <> 0 Then
Err.Clear
propSet.Add val, propName
End If
On Error GoTo 0
End Sub
Sub HandleDatePrompt(propSet As PropertySet, propName As String, todayStr As String)
Dim msg As String
Dim response As String
Dim newDate As String
msg = "What would you like to do for '" & propName & "'?" & vbCrLf & _
"1 - Set to today's date (" & todayStr & ")" & vbCrLf & _
"2 - Leave existing date as-is" & vbCrLf & _
"3 - Enter a new date (use your computer's format: " & todayStr & ")"
response = InputBox(msg, "Date Option", "1")
Select Case Trim(response)
Case "1"
SetOrAdd propSet, propName, todayStr
Case "3"
newDate = InputBox("Enter the new date for '" & propName & "':", "Manual Date", todayStr)
If newDate <> "" Then
SetOrAdd propSet, propName, newDate
End If
Case Else
' Do nothing (option 2 or invalid input)
End Select
End Sub
