09-26-2017
06:45 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
09-26-2017
06:45 AM
Sure, here's my file control functions. Right now, instead of getting the name of the new file, I have to declare the new location and have it look for the latest file. If it doesn't go to the proper location, it won't open the right file.
Something to note is that while it says to "Create from template", these aren't your typical empty file templates with just properties preset and everything. These are actually fully modeled assemblies with rules associated with them that dynamically model the assemblies based on input information.
Private Sub CreateCoverPlates_Click()
On Error GoTo ErrorHandler
'Save workbook so that assemblies are getting latest updated file
ThisWorkbook.Save
'Declare Variables
Dim Exist As Boolean
Dim Rotation As Boolean
Dim CoverPlateGap As Double
Dim Length As Double
Dim Width As Double
Dim Point(2) As Double
Dim i As Integer
Dim oRow As Integer
Dim oRow2 As Integer
Dim FileName As String
Dim JobBook As String
Dim Location As String
Dim Material As String
Dim SheetName As String
Dim PlateFile As String
Dim PlateType As String
Dim Template As String
Dim UOM As UnitsOfMeasure
Dim ListSheet As Worksheet
Dim JobSheet As Worksheet
Dim Doc As Inventor.Document
Dim InventorObjects As Variant
Dim oInventor As Inventor.Application
Dim CoverPlateDoc As PartDocument
Dim CoverPlateObjects As Variant
Dim CoverPlateInventor As Inventor.Application
'Setting up file information
FileName = "INVENTOR COVER PLATES.xlsx"
JobBook = ThisWorkbook.Name
Location = "N:\Mechpart\TLONG\Parts Lists\"
SheetName = "Sheet1"
Template = "C:\Work\Designs\Project Documents\EDH\Working Projects\Dynamic Base Assemblies\Dynamic Cover Plate.ipt"
'Opening list of created plates
Workbooks.Open FileName:=Location & FileName, ReadOnly:=True
'Windows(FileName).Visible = False
'Open new assembly file for cover plate layout
InventorObjects = FileControl.OpenInventorFile("Assembly (Imperial).iam", True)
Set oInventor = InventorObjects(0)
Set Doc = InventorObjects(1)
oInventor.ScreenUpdating = False
Set ListSheet = Workbooks(FileName).Sheets(SheetName)
Set JobSheet = Workbooks(JobBook).Worksheets("Cover Plates")
oRow = 1
'Iterate through all cover plates in the list
With JobSheet
Do While .Range("A" & oRow) <> ""
Exist = False
PlateFile = ""
'Determine Plate information
PlateType = .Range("A" & oRow)
If PlateType = "Surface" Then
CoverPlateGap = 0.75
Material = Workbooks(JobBook).Worksheets("PCR").Range("B4")
ElseIf PlateType = "Flush" Then
CoverPlateGap = 0.9375
If Workbooks(JobBook).Worksheets("PCR").Range("B5") = True Then
If Split(Workbooks(JobBook).Worksheets("PCR").Range("B4"), " ")(1) = "AL" Then
Material = "1/8 " & Split(Workbooks(JobBook).Worksheets("PCR").Range("B4"), " ")(1)
Else
Material = "12GA " & Split(Workbooks(JobBook).Worksheets("PCR").Range("B4"), " ")(1)
End If
Else
Material = Workbooks(JobBook).Worksheets("PCR").Range("B4")
End If
End If
Length = Application.WorksheetFunction.Max(.Range("B" & oRow), .Range("C" & oRow)) + 2 * CoverPlateGap
Width = Application.WorksheetFunction.Min(.Range("B" & oRow), .Range("C" & oRow)) + 2 * CoverPlateGap
Point(0) = .Range("D" & oRow) - CoverPlateGap
Point(1) = .Range("F" & oRow) - CoverPlateGap
Point(2) = 0
If Abs(.Range("E" & oRow) - .Range("D" & oRow)) < Abs(.Range("G" & oRow) - .Range("F" & oRow)) Then
Rotation = True
Else
Rotation = False
End If
'Search through the list of existing cover plates for a match
oRow2 = 1
Do While ListSheet.Range("A" & oRow2) <> ""
If ListSheet.Range("A" & oRow2) = Length And ListSheet.Range("B" & oRow2) = Width And ListSheet.Range("C" & oRow2) = Material And UCase(ListSheet.Range("D" & oRow2)) = UCase(PlateType) Then
PlateFile = ListSheet.Range("E" & oRow2)
Exist = True
Exit Do
End If
oRow2 = oRow2 + 1
Loop
If Exist = False Then
Workbooks(JobBook).Activate
CoverPlateObjects = FileControl.CreateFromTemplate("C:\Work\Designs\Project Documents\EDH\Working Projects\Dynamic Base Assemblies\Dynamic Cover Plate.ipt")
Set CoverPlateInventor = CoverPlateObjects(0)
Set CoverPlateDoc = CoverPlateObjects(1)
PlateFile = CoverPlateDoc.FullFileName
CoverPlateDoc.Activate
'Update part parameters
Set UOM = CoverPlateDoc.UnitsOfMeasure
Set oParameters = CoverPlateDoc.ComponentDefinition.Parameters
Set oLength = oParameters.Item("CutoutLength")
Set oWidth = oParameters.Item("CutoutWidth")
Set oMaterial = oParameters.Item("Material")
Set oType = oParameters.Item("Type")
oLength.Value = Application.WorksheetFunction.Max(.Range("B" & oRow), .Range("C" & oRow)) * 2.54
oWidth.Value = Application.WorksheetFunction.Min(.Range("B" & oRow), .Range("C" & oRow)) * 2.54
oMaterial.Value = UCase(Material)
oType.Value = UCase(PlateType)
'Create new part
Call InventorFunctions.RuniLogic(CoverPlateInventor, "Create Cover Plate", False)
Call InventorFunctions.RuniLogic(CoverPlateInventor, "Drawing Creation", False)
Doc.Activate
Workbooks(FileName).Close
Workbooks.Open FileName:=Location & FileName, ReadOnly:=True
Set ListSheet = Workbooks(FileName).Sheets(SheetName)
End If
Call InventorFunctions.PlacePart(oInventor, PlateFile)
Call InventorFunctions.MovePart(oInventor, PlateFile, Point, Rotation)
oRow = oRow + 1
Loop
End With
ErrorHandler:
'Closing list of created plates
oInventor.ScreenUpdating = True
Workbooks(FileName).Close
End Sub
'Creates a copy of a file and opens it
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function CreateFromTemplate(TemplateFile As String) As Variant
Dim oInventor As Inventor.Application
Dim InventorObjects As Variant
Dim Doc As Inventor.Document
Dim NewFile As String
InventorObjects = OpenInventorFile(TemplateFile, False)
Set oInventor = InventorObjects(0)
Set Doc = InventorObjects(1)
Doc.Save
Doc.Close (True)
NewFile = FileControl.GetLatestFile(Split(TemplateFile, ".")(UBound(Split(TemplateFile, "."))))
CreateFromTemplate = OpenInventorFile(NewFile, False)
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'Opens an existing file or creates a new one. Returns the file reference
'Pass it the template you wish to use for a new document. Acceptable template files listed below
' Assembly (Imperial).iam, ASTM Angle.ipt, ASTM Channel.ipt, ASTM Miscellaneous Channel.ipt, ASTM Rectangular Tube.ipt, ASTM Wide Flange Beam.ipt, _
' Copper Bar Part (Imperial).ipt, Grating Material Template (Imperial).ipt, Non-Metallic Sheet Outsourced.ipt, Part - Other (Imperial).ipt, _
' Roll Fromed Coil.ipt, Sheet Metal Part (Imperial).ipt, Weldment (Imperial).iam
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function OpenInventorFile(FileName As String, NewFile As Boolean) As Variant
On Error Resume Next
Dim InventorObjects(1) As Object
Dim Doc As Inventor.Document
Dim oInventor As Inventor.Application
Dim Location As String
Dim TemplateName As String
Dim DocType As DocumentTypeEnum
'Get open instance of inventor or open one if nothing is found
Set oInventor = GetObject(, "Inventor.Application")
If Err Then
Err.Clear
Set oInventor = CreateObject("Inventor.Application")
Do Until oInventor.Ready = True
Application.Wait (1)
Loop
For j = 1 To oInventor.ApplicationAddIns.Count
oAddin = oInventor.ApplicationAddIns.Item(j)
oStr = oStr & j & ") " & oAddin.DisplayName & " - " & oAddin.Activated
Next
End If
oInventor.Visible = True
'If this is an old file simply open it
If NewFile = False Then
Set Doc = oInventor.Documents.Open(FileName)
'If it is a new file then determine the template and document and add a new file
Else
Location = "C:\Work\Designs\Templates\2013\Inventor Templates\Imperial\"
TemplateName = Location & FileName
If FileName = "Assembly (Imperial).iam" Or FileName = "Weldment (Imperial).iam" Then
DocType = kAssemblyDocumentObject
Else
DocType = kPartDocumentObject
End If
Set Doc = oInventor.Documents.Add(DocType, TemplateName, True)
End If
Set InventorObjects(0) = oInventor
Set InventorObjects(1) = Doc
OpenInventorFile = InventorObjects
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Returns the latest instance of a file of the specified extension in a string. Asterisk can be used for any file type
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Public Function GetLatestFile(Extension As String) As String
Dim FileSpec As String
Dim LatestFile As String
Dim Location As String
Dim FileList() As String
Dim FileName As String
Location = ActiveWorkbook.Path
FileSpec = Location & "*.*"
FileName = Dir(FileSpec)
Do While Len(FileName) > 0
If Split(FileName, ".")(UBound(Split(FileName, "."))) = Extension Then
If LatestFile <> "" Then
If FileDateTime(Location & FileName) > FileDateTime(LatestFile) Then
LatestFile = Location & FileName
End If
Else
LatestFile = Location & FileName
End If
End If
FileName = Dir
Loop
If LatestFile = "" Then
MsgBox ("No assemblies found")
Exit Function
Else
GetLatestFile = LatestFile
End If
End Function
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\