Hello
I have tried to modify it a little bit, it works but it is not perfect modify se in red
I hope now to implent so part dont comes out as mirror se picture above
I hope also to get part will come in diffrent folder after thickness if it is possible also pcs so i dont have to do that manuell
Sub Export_Plasma()
'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveDocument
Dim oAsmName As String
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) - 4)
'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MsgBox ("Please run this rule from the assembly file.")
Exit Sub
End If
'get user input
Result = MsgBox("This will create a DWG file for all of the asembly components that are sheet metal." _
& vbLf & "This rule expects that the part file is saved." _
& vbLf & " " _
& vbLf & "Are you sure you want to create DWG for all of the assembly components?" _
& vbLf & "This could take a while.", vbYesNo, "iLogic - Batch Output DWGs ")
If Result = vbNo Then
Exit Sub
End If
Dim oPath As String
Dim iSplit As Integer
iSplit = InStrRev(oAsmDoc.FullDocumentName, "\")
oPath = Left(oAsmDoc.FullDocumentName, iSplit - 1)
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
'get DXF target folder path
Dim oFolder As String
oFolder = oPath & "\" & oAsmName & " Plasma Filer"
'Check for the DXF folder and create it if it does not exist
If Len(Dir(oFolder, vbDirectory)) = 0 Then
MkDir oFolder
End If
'- - - - - - - - - - - - -
'- - - - - - - - - - - - -Component - - - - - - - - - - - -
'look at the files referenced by the assembly
Dim oRefDocs As DocumentsEnumerator
Set oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
Dim iptPathName As String
'work the the drawing files for the referenced models
'this expects that the model has been saved
For Each oRefDoc In oRefDocs
If oRefDoc.DocumentSubType.DocumentSubTypeID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
Dim oDrawDoc As PartDocument
Set oDrawDoc = ThisApplication.Documents.Open(oRefDoc.FullDocumentName, True)
oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName) - 4)
'Set the DWG target file name
oDataMedium.FileName = oFolder & "\" & oFileName & ".dwg"
Dim oCompDef As SheetMetalComponentDefinition
Set oCompDef = oDrawDoc.ComponentDefinition
If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
Else
oCompDef.FlatPattern.Edit
End If
Dim sOut As String
sOut = "FLAT PATTERN DWG?AcadVersion=2004&OuterProfileLayer=Cut&OuterProfileLayerColor=0;255;0&featureprofilesdownLayer=Scribe&featureprofilesdownLayerColor=255;0;255&interiorprofilesLayer=Cut&InvisibleLayers=IV_BEND_DOWN;IV_TANGENT;IV_TOOL_CENTER;IV_TOOL_CENTER_DOWN;IV_ARC_CENTERS;IV_ALTREP_FRONT;IV_ALTREP_BACK;IV_UNCONSUMED_SKETCHES;IV_ROLL_TANGENT;IV_ROLL"
Call oCompDef.DataIO.WriteDataToFile(sOut, oFolder & "\" & oFileName & ".dwg")
'just for check its works coretcly
'i=MessageBox.Show(oDataMedium.FileName, "Title",MessageBoxButtons.OKCancel)
'MessageBox.Show(i,"title",MessageBoxButtons.OK)
'If i=2 Then
'Exit Sub
'End If
oCompDef.FlatPattern.ExitEdit
oDrawDoc.Close
End If
Next
End Sub
