- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi, i've this rule to Publish the documentation for laser cutting and pdf for a metal sheet part.
It run only in a drawing. Is possible to use this in an assembly and subassembly to do this for each metal sheet?
Imports System.Diagnostics
oPath = ThisDoc.Path
'oFileName = ThisDoc.FileName(False) 'without extension
oFileName = Split(ThisDoc.FileName(False), "_T")(0)
oPDFAddIn = ThisApplication.ApplicationAddIns.ItemById _
("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
oDocument = ThisApplication.ActiveDocument
oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
oOptions = ThisApplication.TransientObjects.CreateNameValueMap
oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
oDataMedium1 = ThisApplication.TransientObjects.CreateDataMedium
'oDataMedium2 = ThisApplication.TransientObjects.CreateDataMedium
If oPDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
oOptions.Value("All_Color_AS_Black") = 0
oOptions.Value("Remove_Line_Weights") = 0
oOptions.Value("Vector_Resolution") = 1200
oOptions.Value("Sheet_Range") = Inventor.PrintRangeEnum.kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2'oOptions.Value("Custom_End_Sheet") = 4
End If
oRefDoc = ThisDrawing.ModelDocument
Dim oPropValue As String
Dim oPropValue1 As String
oPropValue = oRefDoc.PropertySets("Summary Information").Item("Revision Number").Value
iProperties.Value("Summary", "Revision Number") = oPropValue
oPropValue1 = oRefDoc.PropertySets.Item("Design Tracking Properties").Item("Material").Value
iProperties.Value("Custom", "Material Type") = oPropValue1
If oPropValue1 = "811195 AISI 304 sp. 3 SB + PVC"
oPropValue1 = "811195 AISI 304 sp. 3.0 SB + PVC"
End If
Rev = iProperties.Value("Summary", "Revision Number")
'get PDF target folder path
Dim oFolder As String
oFolder = "\\SRVDOC2016\pubblica\Foto-Articoli-AS400\"
Dim PDFFolder2 As String
PDFFolder2 = "\\SRVDOC2016\pubblica\Foto-Articoli-AS400_REV_VECCHIE"
If Not System.IO.Directory.Exists(oFolder) Then
System.IO.Directory.CreateDirectory(oFolder)
End If
Dim Materiale As String = iProperties.Value("Custom", "Material Type")
If Not System.IO.Directory.Exists("\\srvdoc2016\PUBBLICA\PRODUZIONE\TAGLIO LASER\" & oPropValue1 & "\") Then
System.IO.Directory.CreateDirectory("\\srvdoc2016\PUBBLICA\PRODUZIONE\TAGLIO LASER\" & oPropValue1 & "\")
End If
'Set the PDF target file name
oDataMedium.FileName = oFolder & "\" & oFileName & ".pdf"
oDataMedium1.FileName = PDFFolder2 & "\" & oFileName & "-" & Rev & ".pdf"
'Publish document
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
oPDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium1)
Dim oPart As PartDocument
Dim oPartPath As String
' Get drawing path
oPartPath = Split(ThisDoc.PathAndFileName(False), "_T")(0) & ".ipt"
' Set a reference to the target part
oPart = ThisApplication.Documents.ItemByName(oPartPath)
' Open the target part
ThisApplication.Documents.Open(oPartPath)
InventorVb.DocumentUpdate(True)
Dim oDoc As Document
oDoc = ThisApplication.ActiveDocument
Dim oType As String
oType = oDoc.DocumentSubType.DocumentSubTypeID
Dim currentStyle As String
currentStyle = iProperties.Material
If oType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
'Set your filepath here:
'SETFilePath = "\\srvdoc2016\PUBBLICA\PRODUZIONE\TAGLIO LASER"' & currentStyle & "\"
Dim partDoc As PartDocument
'Check for flat pattern >> create one if needed
Dim oDoc01 As PartDocument
oDoc01 = ThisApplication.ActiveDocument
Dim oCompDef As SheetMetalComponentDefinition
oCompDef = oDoc01.ComponentDefinition
If oCompDef.HasFlatPattern = False Then
oCompDef.Unfold
Else
oCompDef.FlatPattern.Edit
End If
'DXF Settings
Dim sOut As String
Dim sPATH As String
sOut = "FLAT PATTERN DWG?AcadVersion=2004&OuterProfileLayer=FUORI&OuterProfileLayerColor=255;0;0&InteriorProfilesLayer=DENTRO&InteriorProfilesLayerColor=255;0;0&BendUpLayer=Layer1&BendUpLayerColor=0;255;255&BendDownLayer=VAPOR&BendDownLayerColor=0;0;255&ToolCenterLayer=Layer3&ToolCenterUpLayer=Layer4&ToolCenterDownLayer=Layer5&FeatureProfilesLayer=Layer6&FeatureProfilesUpLayer=7&FeatureProfilesDownLayer=Layer8&AltRepFrontLayer=Layer9&AltRepBackLayer=Layer9&InvisibleLayers=IV_ARC_CENTERS;IV_TANGENT;IV_BEND;Layer3;Layer4;Layer5;Layer9&BendUpLayerLineType=37644&BendDownLayerLineType=37644&FeatureProfilesDownLayerColor=255;255;0&FeatureProfilesUpLayerColor=255;255;0&FeatureProfilesLayerColor=255;255;0"
Dim sFname As String
sFname = "\\srvdoc2016\PUBBLICA\PRODUZIONE\TAGLIO LASER\" & oPropValue1 & "\" & Split(ThisDoc.FileName(False), "_T")(0) & "-" & Rev & ".dwg" ' & "\" & oPropValue1
pFname = ThisDoc.FileName(False) & ".ipt"
'Export the DXF and fold the model back up
oCompDef.DataIO.WriteDataToFile( sOut, sFname)
Dim oSMDef As SheetMetalComponentDefinition
oSMDef = oDoc01.ComponentDefinition
oSMDef.FlatPattern.ExitEdit
Else
GoTo Update
End If
Update :
InventorVb.DocumentUpdate(False)
opendoc = Split(ThisDoc.PathAndFileName(False), "_T")(0) 'ThisDoc.PathAndFileName()'saves doc path and file name
doc = ThisApplication.Documents.Open(opendoc & ".ipt")'saves 'doc' as the open application from 'opendoc' adding the extension '.iam'
doc.Close 'closes the indicated document 'doc'
InventorVb.DocumentUpdate(False)
InventorVb.DocumentUpdate(False)
Ive try this but no luck for me
iLogicVb.UpdateWhenDone = True
Dim oAsm As AssemblyDocument = ThisDoc.Document
For Each oRefDoc As Document In oAsm.AllReferencedDocuments
If oRefDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject AndAlso _
oAsm.ComponentDefinition.Occurrences.AllReferencedOccurrences(oRefDoc).Count > 0
On Error Resume Next
iLogicVb.Automation.RunRule(oRefDoc, "iLogic_rule")
End If
Next
What i want to do is:
In assemlby file, for each
{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}
in assembly open Drawing, run rule, close drawing, next.
Thank you all
Danilo "DannyGi" G.
Mechanical design engineer and product developer
Mechanical design engineer and product developer
Solved! Go to Solution.