Autodesk Inventor

Макрос объединения нескольких файлов чертежей из текущей директории в один многолистовой файл. Тестировался на AIP 11 SP3.

Sub MergeIDW()
Dim i As Integer

Dim oDrawDoc1 As DrawingDocument

Set oDrawDoc1 = ThisApplication.Documents.Add(kDrawingDocumentObject)

Dim CDLG As ComDlg
Set CDLG = New ComDlg
With CDLG
.DialogTitle = "Select files for merging"
.Filter = "Drawings Files (*.idw)|*.idw"
.FilterIndex = 1
.CheckBoxSelected = True
.AllowMultiSelect = True
.ExistFlags = FileMustExist + PathMustExist
If .ShowOpen Then
For i = 1 To .FileNames.Count

Dim oDoc As DrawingDocument

ThisApplication.SilentOperation = True

Set oDoc = ThisApplication.Documents.Open(.FileNames(i), False)

ThisApplication.SilentOperation = False

Dim s As Sheet

For Each s In oDoc.Sheets
s.Activate
Call s.CopyTo(oDrawDoc1)
Next

oDoc.Close
Next
End If
End With

Set CDLG = Nothing

oDrawDoc1.Sheets.Item(1).Delete

oDrawDoc1.Activate
End Sub

Для работы используется класс ComDlg для организации диалога открытия файлов с возможностью мультивыбора.

Текст класса (создайте новый класс с именем ComDlg и просто скопируйте текст туда):
Скрытый текст

Option Explicit

DefStr S
DefLng N
DefBool B
DefVar V

' OFN constants.
Const OFN_ALLOWMULTISELECT As Long = &H200
Const OFN_CREATEPROMPT As Long = &H2000
Const OFN_EXPLORER As Long = &H80000
Const OFN_EXTENSIONDIFFERENT As Long = &H400
Const OFN_FILEMUSTEXIST As Long = &H1000
Const OFN_HIDEREADONLY As Long = &H4
Const OFN_LONGNAMES As Long = &H200000
Const OFN_NOCHANGEDIR As Long = &H8
Const OFN_NODEREFERENCELINKS As Long = &H100000
Const OFN_OVERWRITEPROMPT As Long = &H2
Const OFN_PATHMUSTEXIST As Long = &H800
Const OFN_READONLY As Long = &H1

' The maximum length of a single file path.
Const MAX_PATH As Long = 260
' This MAX_BUFFER value allows you to select approx.
' 500 files with an average length of 25 characters.
' Change this value as needed.
Const MAX_BUFFER As Long = 50 * MAX_PATH
' String constants:
Const sBackSlash As String = "\"
Const sPipe As String = "|"

' API functions to use the Windows common dialog boxes.
Private Declare Function GetOpenFileName _
Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName _
Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetActiveWindow _
Lib "user32" () As Long

' Type declaration, used by GetOpenFileName and
' GetSaveFileName.
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String ' Can also be a Long.
End Type

' Private variables.
Private OFN As OPENFILENAME
Private colFileTitles As New Collection
Private colFileNames As New Collection
Private sFullName
Private sFileTitle
Private sPath
Private sExtension

' Public enumeration variable.
Public Enum XFlags
PathMustExist = OFN_PATHMUSTEXIST
FileMustExist = OFN_FILEMUSTEXIST
PromptToCreateFile = OFN_CREATEPROMPT
End Enum

Property Let AllowMultiSelect(bFlag)
SetFlag OFN_ALLOWMULTISELECT, bFlag
End Property

Property Let DialogTitle(sCaption)
OFN.lpstrTitle = sCaption
End Property

Property Let Filter(vFilter)
If IsArray(vFilter) Then _
vFilter = Join(vFilter, vbNullChar)
OFN.lpstrFilter = _
Replace(vFilter, sPipe, vbNullChar) & vbNullChar
End Property

Property Get Filter()
With OFN
If .nFilterIndex Then
Dim sTemp()
sTemp = Split(.lpstrFilter, vbNullChar)
Filter = sTemp(.nFilterIndex * 2 - 2) & sPipe & _
sTemp(.nFilterIndex * 2 - 1)
End If
End With
End Property

Property Let FilterIndex(nIndex)
OFN.nFilterIndex = nIndex
End Property

Property Get FilterIndex() As Long
FilterIndex = OFN.nFilterIndex
End Property

Property Let RestoreCurDir(bFlag)
SetFlag OFN_NOCHANGEDIR, bFlag
End Property

Property Let ExistFlags(nFlags As XFlags)
OFN.Flags = OFN.Flags Or nFlags
End Property

Property Let CheckBoxVisible(bFlag)
SetFlag OFN_HIDEREADONLY, Not bFlag
End Property

Property Let CheckBoxSelected(bFlag)
SetFlag OFN_READONLY, bFlag
End Property

Property Get CheckBoxSelected() As Boolean
CheckBoxSelected = OFN.Flags And OFN_READONLY
End Property

Property Let FileName(sFileName)
If Len(sFileName) <= MAX_PATH Then _
OFN.lpstrFile = sFileName
End Property

Property Get FileName() As String
FileName = sFullName
End Property

Property Get FileNames() As Collection
Set FileNames = colFileNames
End Property

Property Get FileTitle() As String
FileTitle = sFileTitle
End Property

Property Get FileTitles() As Collection
Set FileTitles = colFileTitles
End Property

Property Let Directory(sInitDir)
OFN.lpstrInitialDir = sInitDir
End Property

Property Get Directory() As String
Directory = sPath
End Property

Property Let Extension(sDefExt)
OFN.lpstrDefExt = LCase$(Left$( _
Replace(sDefExt, ".", vbNullString), 3))
End Property

Property Get Extension() As String
Extension = sExtension
End Property

Function ShowOpen() As Boolean
ShowOpen = Show(True)
End Function

Function ShowSave() As Boolean
' Set or clear appropriate flags for Save As dialog.
SetFlag OFN_ALLOWMULTISELECT, False
SetFlag OFN_PATHMUSTEXIST, True
SetFlag OFN_OVERWRITEPROMPT, True
ShowSave = Show(False)
End Function

Private Function Show(bOpen)
With OFN
.lStructSize = Len(OFN)
' Could be zero if no owner is required.
.hwndOwner = GetActiveWindow
' If the RO checkbox must be checked, we should also
' display it.
If .Flags And OFN_READONLY Then _
SetFlag OFN_HIDEREADONLY, False
' Create large buffer if multiple file selection
' is allowed.
.nMaxFile = IIf(.Flags And OFN_ALLOWMULTISELECT, _
MAX_BUFFER + 1, MAX_PATH + 1)
.nMaxFileTitle = MAX_PATH + 1
' Initialize the buffers.
.lpstrFile = .lpstrFile & String$( _
.nMaxFile - 1 - Len(.lpstrFile), 0)
.lpstrFileTitle = String$(.nMaxFileTitle - 1, 0)

' Display the appropriate dialog.
If bOpen Then
Show = GetOpenFileName(OFN)
Else
Show = GetSaveFileName(OFN)
End If

If Show Then
' Remove trailing null characters.
Dim nDoubleNullPos
nDoubleNullPos = InStr(.lpstrFile & vbNullChar, _
String$(2, 0))
If nDoubleNullPos Then
' Get the file name including the path name.
sFullName = Left$(.lpstrFile, nDoubleNullPos - 1)
' Get the file name without the path name.
sFileTitle = Left$(.lpstrFileTitle, _
InStr(.lpstrFileTitle, vbNullChar) - 1)
' Get the path name.
sPath = Left$(sFullName, .nFileOffset - 1)
' Get the extension.
If .nFileExtension Then
sExtension = Mid$(sFullName, .nFileExtension + 1)
End If
' If sFileTitle is a string,
' we have a single selection.
If Len(sFileTitle) Then
' Add to the collections.
colFileTitles.Add _
Mid$(sFullName, .nFileOffset + 1)
colFileNames.Add sFullName
Else ' Tear multiple selection apart.
Dim sTemp(), nCount
sTemp = Split(sFullName, vbNullChar)
' If array contains no elements,
' UBound returns -1.
If UBound(sTemp) > LBound(sTemp) Then
' We have more than one array element!
' Remove backslash if sPath is the root folder.
If Len(sPath) = 3 Then _
sPath = Left$(sPath, 2)
' Loop through the array, and create the
' collections; skip the first element
' (containing the path name), so start the
' counter at 1, not at 0.
For nCount = 1 To UBound(sTemp)
colFileTitles.Add sTemp(nCount)
' If the string already contains a backslash,
' the user must have selected a shortcut
' file, so we don't add the path.
If InStr(sTemp(nCount), sBackSlash) Then
colFileNames.Add sTemp(nCount)
Else
colFileNames.Add sPath & sBackSlash & sTemp(nCount)
End If
Next
' Clear this variable.
sFullName = vbNullString
End If
End If
' Add backslash if sPath is the root folder.
If Len(sPath) = 2 Then _
sPath = sPath & sBackSlash
End If
End If
End With
End Function

Private Sub SetFlag(nValue, bTrue)
' Wrapper routine to set or clear bit flags.
With OFN
If bTrue Then
.Flags = .Flags Or nValue
Else
.Flags = .Flags And Not nValue
End If
End With
End Sub

Private Sub Class_Initialize()
' This routine runs when the object is created.
OFN.Flags = OFN.Flags Or OFN_EXPLORER Or _
OFN_LONGNAMES Or OFN_HIDEREADONLY
End Sub