04-21-2021
05:45 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
04-21-2021
05:45 AM
Test dit eens:
Welke messages krijg je:
Imports System.IO
GetInput :
Dim Filename As String = "C:\Autodesk en Templates\PTN_Part_Library\New_PTN_Part_Library.xlsx"
Dim ExcelApp As Object
Dim opened As Boolean
Dim wb As Object
Dim Six_Digit As String
Msgbox ("A")
ExcelApp = GetObject("", "Excel.Application")
opened = False
Msgbox ("B")
For Each wb In ExcelApp.workbooks
If UCase(wb.fullname) = UCase(Filename) Then
opened = True
Msgbox ("C")
Exit For
End If
Next
If Not opened Then
GoExcel.Open("C:\Autodesk en Templates\PTN_Part_Library\New_PTN_Part_Library.xlsx")
'GoExcel.Open("C:\Users\ef\Desktop\New_PTN_Part_Library.xlsx")
Msgbox ("D")
Six_Digit = ExcelApp.ActiveCell.Value
Msgbox ("Excel six Digit " & Six_Digit)
If Six_Digit = "" Then
Return
Else If Len(Six_Digit) <> "6" Then
MessageBox.Show("Input must be 6 digits", "ilogic")
GoTo GetInput
End If
Dim oDoc As Document
Dim sFilename As String
'hard code path
oLibrary_Folder = "C:\Autodesk en Templates\PTN_Part_Library\"
Dim oFilenames() As String
oFilenames = System.IO.Directory.GetFiles(oLibrary_Folder, _
"*.*", SearchOption.AllDirectories)
Msgbox ("E ")
For Each oFilename As String In oFilenames
Dim oFileNameNoExt As String = System.IO.Path.GetFileNameWithoutExtension(oFilename)
If oFileNameNoExt.Contains(Six_Digit) AndAlso oFileNameNoExt.Length = 11 Then
Dim oOptions As Inventor.NameValueMap
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDoc = ThisApplication.Documents.OpenWithOptions(oFilename, oOptions, False)
sFilename = oFilename
Exit For
End If
Next
If sFilename = "" Then
MessageBox.Show("No matching libary file found.", "iLogic")
Return
End If
'path from current file
Dim oActiveAssemblyfolder As String = ThisDoc.Path & "\"
Msgbox ("F ")
'find the postion of the last backslash in the path
Dim FNamePos As Integer = InStrRev(sFilename, "\", -1)
'get the file name with the file extension
Dim oName As String = Right(sFilename, Len(sFilename) -FNamePos)
'get the file name (without extension)
Dim ShortName As String = Left(oName, Len(oName) -4)
'get extension
Dim oExt As String = Right(oName, 4)
Msgbox ("G ")
Dim oNewName As String = ShortName & "_" & System.DateTime.Now.ToString("yyyyMdHHmmss")
Dim oPathandName As String = oActiveAssemblyfolder & oNewName & oExt
Msgbox ("H ")
oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value = ShortName
'save new document
oDoc.SaveAs(oPathandName, True)
oDoc.Close
Msgbox ("I")
'[ Place Component
Dim oAsmCompDef As AssemblyComponentDefinition
oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
Msgbox ("J ")
' Create Matrix
Dim oMatrix As Matrix
oMatrix = ThisApplication.TransientGeometry.CreateMatrix
Call oMatrix.SetTranslation(ThisApplication.TransientGeometry.CreateVector(50, 50, 50), True)
Msgbox ("K ")
'insert new occurence
'Dim oOcc As ComponentOccurrence
'oOcc = oAsmCompDef.Occurrences.Add( _
'oPathandName, oMatrix)
Msgbox ("L ")
ThisApplication.CommandManager.PostPrivateEvent(PrivateEventTypeEnum.kFileNameEvent, oPathandName)
ThisApplication.CommandManager.ControlDefinitions.Item("AssemblyPlaceComponentCmd").Execute
Msgbox ("M ")
Regards,
Arthur Knoors
Autodesk Affiliations:
Autodesk Software:Inventor Professional 2025 | Vault Professional 2024 | Autocad Mechanical 2024
Programming Skills:Vba | Vb.net (Add ins Vault / Inventor, Applications) | I-logic
Programming Examples:Drawing List!|Toggle Drawing Sheet!|Workplane Resize!|Drawing View Locker!|Multi Sheet to Mono Sheet!|Drawing Weld Symbols!|Drawing View Label Align!|Open From Balloon!|Model State Lock!
Posts and Ideas:Dimension Component!|Partlist Export!|Derive I-properties!|Vault Prompts Via API!|Vault Handbook/Manual!|Drawing Toggle Sheets!|Vault Defer Update!
! For administrative reasons, please mark a "Solution as solved" when the issue is solved !