Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
shastu
in reply to: DRoam

Dim oApp As Application
 Dim oCurrentDoc As Document
 Dim oNewDoc As Document
 Dim UseDefaultTemplate As Boolean
 Dim sCurrentFileName As String
 Dim sTemplatePart As String
 Set oApp = ThisApplication
 Set oCurrentDoc = oApp.ActiveDocument
 Select Case oApp.ActiveDocumentType
 Case kAssemblyDocumentObject, kPartDocumentObject
sCurrentFileName = ThisApplication.ActiveDocument.FullFileName
If sCurrentFileName = "" Then
MsgBox "The active file must first be saved"
Exit Sub
End If
'if you want to use the default template then set UseDefaultTemaplte = True
'if you want to use a custom template set the path and filename of sTemplatePart and UseDefaultTemaplte = False
UseDefaultTemplate = False
sTemplatePart = "Q:\Inventor\Templates_v2017\part.ipt"
Select Case UseDefaultTemplate
Case True
Set oNewDoc = oApp.Documents.Add(kPartDocumentObject)
Case False
Set oNewDoc = oApp.Documents.Add(kPartDocumentObject, sTemplatePart, True)
End Select
 '******START UPDATED CODE **************
 'If your template has an active sketch you need to close it.
Dim oSketch As Sketch
On Error Resume Next
Set oSketch = oNewDoc.ComponentDefinition.Sketches.Item(1)
oSketch.ExitEdit
On Error GoTo 0
 '******END UPDATED CODE **************
'Get the control definition that represents the derived part command.
Dim oDerivedCommandDef As ControlDefinition
Set oDerivedCommandDef = ThisApplication.CommandManager.ControlDefinitions.Item("PartDerivedComponentCmd")
'Post the filename to the private event queue.
Call ThisApplication.CommandManager.PostPrivateEvent(kFileNameEvent, sCurrentFileName)
'Start the derived part command.
oDerivedCommandDef.Execute
 Case Else
MsgBox "You must first have a Part or Assembly document open"
 End Select