DxfFold=Left$(oDoc.FullFileName, InStrRev(oDoc.FullFileName, "\"))

oDataMedium.FileName = NfPath & "dxf"

MsgBox oDataMedium.FileName

DxfFold=Left$(oDoc.FullFileName, InStrRev(oDoc.FullFileName, "\"))

oDataMedium.FileName = NfPath & "dxf"

Sub AssemblyDxfExport()
If ThisApplication.Documents.count = 0 Then MsgBox "Brak otwartych dokumentów": Exit Sub
If Not ThisApplication.ActiveDocument.DocumentType = kAssemblyDocumentObject Then MsgBox "Otwarty dokument nie zlozeniem! ": Exit Sub

Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oBOM As BOM
Set oBOM = oDoc.ComponentDefinition.BOM
Dim oPartsOnlyBOMView As BOMView

If oBOM.StructuredViewFirstLevelOnly Then oBOM.StructuredViewFirstLevelOnly = False
oBOM.PartsOnlyViewEnabled = True
Set oPartsOnlyBOMView = oBOM.BOMViews.Item(oBOM.BOMViews.count)

Dim colSH As ObjectCollection
Set colSH = ThisApplication.TransientObjects.CreateObjectCollection

Dim BR As BOMRow

For Each BR In oPartsOnlyBOMView.BOMRows
    If BR.ComponentDefinitions.Item(1).Document.DocumentType = kPartDocumentObject Then
        If BR.ComponentDefinitions.Item(1).Document.DocumentSubType.DocumentSubTypeID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
            If Not BR.ComponentDefinitions.Item(1).Document.ComponentDefinition.FlatPattern Is Nothing Then
                colSH.Add BR
            End If
        End If
    End If
Next BR

If colSH.count = 0 Then MsgBox "Brak blach z rowinieciami!", vbCritical: Set colSH = Nothing: Exit Sub

Dim oPartDoc As PartDocument
Dim W As Double, H As Double
Dim oPt As Point2d
Dim oView As DrawingView
Dim sH As BOMRow

Dim oBaseViewOptions As NameValueMap
Set oBaseViewOptions = ThisApplication.TransientObjects.CreateNameValueMap
Call oBaseViewOptions.Add("SheetMetalFoldedModel", False)

Dim DXFAddIn As TranslatorAddIn
Set DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")

Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism

Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap

Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium

Dim DxfFold As String: DxfFold = "C:\temp\"
Dim strIniFile As String
Dim NfPath As String

Dim oDrw As DrawingDocument
Set oDrw = ThisApplication.Documents.Add(kDrawingDocumentObject, ThisApplication.FileManager.GetTemplateFile(kDrawingDocumentObject))
oDrw.SaveAs DxfFold & "Temp.idw", False

Dim oSheet As Sheet
Set oSheet = oDrw.Sheets.Item(1)
W = oSheet.width: H = oSheet.Height
Set oPt = ThisApplication.TransientGeometry.CreatePoint2d(W / 2, H / 2)

strIniFile = "C:\dxfExport.ini"
If Dir(strIniFile) = "" Then MsgBox "Plik ini nie istnieje!", vbCritical: Set colSH = Nothing: Exit Sub

Dim RaportTxt As String: RaportTxt = ""
Close #1
Open DxfFold & "Raport_" & Format(Now(), "YYMMDD_hhmmss") & ".txt" For Append As #1
    
For Each sH In colSH
    
    NfPath = DxfFold & Mid(sH.ComponentDefinitions.Item(1).Document.DisplayName, 1, InStrRev(sH.ComponentDefinitions.Item(1).Document.DisplayName, "."))

    Set oView = oSheet.DrawingViews.AddBaseView(sH.ComponentDefinitions.Item(1).Document, oPt, 0.1, kDefaultViewOrientation, kHiddenLineRemovedDrawingViewStyle, , , oBaseViewOptions)
    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
    If oView.ShowName = False Then oView.ShowName = True
    RaportTxt = "Grubosc = " & sH.ComponentDefinitions.Item(1).Document.ComponentDefinition.Thickness.ModelValue * 10 & " | Material = " & sH.ComponentDefinitions.Item(1).Document.ComponentDefinition.Material.name & " | Ilosc = " & sH.ItemQuantity
    '*************************************************
    If DXFAddIn.HasSaveCopyAsOptions(oDrw, oContext, oOptions) Then oOptions.Value("Export_Acad_IniFile") = strIniFile
    oDataMedium.FileName = NfPath & "dxf"
    
    DoEvents
    Call DXFAddIn.SaveCopyAs(oDrw, oContext, oOptions, oDataMedium)
    DoEvents
    '*************************************************
    
    If Not Dir(NfPath & "dxf") = "" Then
        Print #1, RaportTxt & " | OK"
    Else
        Print #1, RaportTxt & " | Blad !"
    End If
    
    oView.Delete

Next sH
    
    oDrw.Close True
    Kill DxfFold & "Temp.idw"
    Set colSH = Nothing
    Close #1
    Set oView = Nothing
    Set oSheet = Nothing
    Set oDrw = Nothing

End Sub

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

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

Dim oDrw As DrawingDocument
Set oDrw = ThisApplication.Documents.Add(kDrawingDocumentObject, ThisApplication.FileManager.GetTemplateFile(kDrawingDocumentObject))

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

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

If oView.ShowName = False Then oView.ShowName = True

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

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