08-14-2019
04:48 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
08-14-2019
04:48 AM
this is the macro that fires the rule, it is added to our ribbon as a button
Public Sub AssemblyExportDXFs()
Dim addIn As ApplicationAddIn
Dim addIns As ApplicationAddIns
Set addIns = ThisApplication.ApplicationAddIns
For Each addIn In addIns
If InStr(addIn.DisplayName, "iLogic") > 0 Then
addIn.Activate
Dim iLogicAuto As Object
Set iLogicAuto = addIn.Automation
Exit For
End If
Next
Debug.Print addIn.DisplayName
Dim RuleName1 As String
EXTERNALrule = "DXF-Flat Patterns Export to Burn" ‘this is where you will call out out your rule name, ours is an external rule
Dim RuleName2 As String
INTERNALrule = "Rule0"
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
If oDoc Is Nothing Then
MsgBox "Missing Inventor Document"
Exit Sub
End If
'iLogicAuto.RunRule oDoc, INTERNALrule 'for internal rule
iLogicAuto.RunExternalRule oDoc, EXTERNALrule 'for external rule
End Subhere is our external rule that is fired from above macro
'define the active document as an assembly file
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
oAsmName = Left(oAsmDoc.DisplayName, Len(oAsmDoc.DisplayName) -4)
'check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from the assembly file.", "iLogic")
Exit Sub
End If
'get user input
RUsure = MessageBox.Show ( _
"This will create a DXF file for all of the assembly components that was created using the sheet metal template." _
& vbLf & "This rule expects that the part file is saved." _
& vbLf & " " _
& vbLf & "Are you sure you want to create DXF for all of the assembly components?" _
& vbLf & "This could take a while.", "iLogic - Batch Output DXFs ",MessageBoxButtons.YesNo)
If RUsure = vbNo Then
Return
Else
End If
oPath = "R:\email\Burn Table" 'this will need to be modified for your use
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
'get DXF target folder path
oFolder = oPath & "\" & oAsmName
'Check for the DXF folder and create it if it does not exist
If Not System.IO.Directory.Exists(oFolder) Then
System.IO.Directory.CreateDirectory(oFolder)
End If
'- - - - - - - - - - - - -
'- - - - - - - - - - - - -Component - - - - - - - - - - - -
'look at the files referenced by the assembly
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAsmDoc.AllReferencedDocuments
Dim oRefDoc As Document
'work the drawing files for the referenced models
'this expects that the model has been saved
For Each oRefDoc In oRefDocs
iptPathName = Left(oRefDoc.FullDocumentName, Len(oRefDoc.FullDocumentName) - 3) & "ipt"
'check that model is saved
If(System.IO.File.Exists(iptPathName)) Then
Dim oDrawDoc As PartDocument
oDrawDoc = ThisApplication.Documents.Open(iptPathName, True)
oFileName = Left(oRefDoc.DisplayName, Len(oRefDoc.DisplayName))
Try
'Set the DXF target file name
ofilename = Left(oRefDoc.displayname, Len(oRefDoc.DisplayName) - 3)
oDataMedium.FileName = oFolder & "\" & oFileName & "dxf"
Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oDrawDoc.ComponentDefinition
If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
Else
oCompDef.FlatPattern.Edit
End If
Dim sOut As String
'this assigns colors to the different layers, this can also be modified
sOut = "FLAT PATTERN DXF?AcadVersion=2004" _
+ "&OuterProfileLayer=OUTER_PROF&OuterProfileLayerColor=255;165;0" _
+ "&InteriorProfilesLayer=INNER_PROFS&InteriorProfilesLayerColor=124;252;0" _
+ "&FeatureProfileLayer=FEATURE&FeatureProfileLayerColor=255;0;255" _
+ "&ArcCentersLayer=CENTERS&ArcCentersLayerColor=135;206;235" _
+ "&IV_Arc_Centers&InvisibleLayers=IV_Tangent;IV_Bend;IV_Bend_Down;IV_Bend_Up&IV_Arc_Centers&InvisibleLayersColor=135;206;235"
oCompDef.DataIO.WriteDataToFile( sOut, oDataMedium.FileName)
'just for checking to see if 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
Catch
End Try
oDrawDoc.Close
Else
End If
NextJason