Niestety nie moge poświecić wystarczajaca czasu żeby napisać takie makro i je przetestować. Poniżej kolejność operacja która musi byyc wykonana wraz z przykładami z helpa.
1. Pobieramy ze złożenia liste części:
Public Sub BOMExport()
' Set a reference to the assembly document.
' This assumes an assembly document is active.
Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument
' Set a reference to the BOM
Dim oBOM As BOM
Set oBOM = oDoc.ComponentDefinition.BOM
' Set the structured view to 'all levels'
oBOM.StructuredViewFirstLevelOnly = False
' Make sure that the structured view is enabled.
oBOM.StructuredViewEnabled = True
' Set a reference to the "Structured" BOMView
Dim oStructuredBOMView As BOMView
Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")
' Export the BOM view to an Excel file
oStructuredBOMView.Export "C:\temp\BOM-StructuredAllLevels.xls", kMicrosoftExcelFormat
' Make sure that the parts only view is enabled.
oBOM.PartsOnlyViewEnabled = True
' Set a reference to the "Parts Only" BOMView
Dim oPartsOnlyBOMView As BOMView
Set oPartsOnlyBOMView = oBOM.BOMViews.Item("Parts Only")
' Export the BOM view to an Excel file
oPartsOnlyBOMView.Export "C:\temp\BOM-PartsOnly.xls", kMicrosoftExcelFormat
End Sub
2. Filtrujemy tylko blachy z rozeinięciami:
Dim BR As BOMRow
For Each BR In oPartsOnlyBOMView.BOMRows
If BR.ComponentDefinitions.Item(1).Document.DocumentType = kPartDocumentObject Then 'tylko cześci
If BR.ComponentDefinitions.Item(1).Document.DocumentSubType.DocumentSubTypeID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then 'tylko blachy
If Not BR.ComponentDefinitions.Item(1).Document.ComponentDefinition.FlatPattern Is Nothing Then 'tylko blachy z rowinieciami
colSH.Add BR 'wpisujemy do kolekcji
End If
End If
End If
Next BR
3.Tworzymy nowy rysunek
Dim oDrw As DrawingDocument
Set oDrw = ThisApplication.Documents.Add(kDrawingDocumentObject, ThisApplication.FileManager.GetTemplateFile(kDrawingDocumentObject))
4. W petli po naszej nowej kolekcji colSH dodajemy widok z rozinięciem.
Public Sub AddFlatPatternDrawingView()
' Set a reference to the drawing document.
' This assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
'Set a reference to the active sheet.
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
' Create a new NameValueMap object
Dim oBaseViewOptions As NameValueMap
Set oBaseViewOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Set the options to use when creating the base view.
Call oBaseViewOptions.Add("SheetMetalFoldedModel", False)
' Open the sheet metal document invisibly
Dim oModel As Document
Set oModel = ThisApplication.Documents.Open("C:\temp\SheetMetal.ipt", False)
' Create the placement point object.
Dim oPoint As Point2d
Set oPoint = ThisApplication.TransientGeometry.CreatePoint2d(25, 25)
' Create a base view.
Dim oBaseView As DrawingView
Set oBaseView = oSheet.DrawingViews.AddBaseView(oModel, oPoint, 1, _
kDefaultViewOrientation, kHiddenLineRemovedDrawingViewStyle, _
, , oBaseViewOptions)
End Sub
ustawiamy etykiete widoku: (sh - element kolekcji, Dim sH As BOMRow)
oView.Label.FormattedText = "Grubosc = " & sH.ComponentDefinitions.Item(1).Document.ComponentDefinition.Thickness.ModelValue * 10 & "<Br/>Material = " & sH.ComponentDefinitions.Item(1).Document.ComponentDefinition.Material.name & "<Br/>Ilosc = " & sH.ItemQuantity
wyswieltlamy etykiete widoku
If oView.ShowName = False Then oView.ShowName = True
5. W tej samej petli robimy export do dxf:
Public Sub PublishDXF()
' Get the DXF translator Add-In.
Dim DXFAddIn As TranslatorAddIn
Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If DXFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
Dim strIniFile As String
strIniFile = "C:\tempDXFOut.ini"
' Create the name-value that specifies the ini file to use.
oOptions.Value("Export_Acad_IniFile") = strIniFile
End If
'Set the destination file name
oDataMedium.FileName = "c:\tempdxfout.dxf"
'Publish document.
Call DXFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
End Sub
6. Zapis raportu do pliku można zrobic tak:
Sub WriteTextToFile(ByVal FileName As String, tekst As String)
'If dIr(FileName) = "" Then Exit Sub
Close #1
Open FileName For Append As #1
Print #1, tekst
Close #1
End Sub
Opis do wszystkich przkładów znajdziesz w helpie do VBA INVENTORA
jak bedziesz miał jakies pytania to pisz. |