Message 1 of 3
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello
Me and my friend try to use this VBA on my inventor 2019 it works perfect, my frien have inventor 2016 and got this trouble, what can be wrong
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 plasma 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 plasma DWG for all of the assembly components?" _ & vbLf & "This could take a minute.", vbYesNo, "This create DWG plasma files ") 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 DWG target folder path Dim oFolder As String oFolder = oPath & "\" & oAsmName & " Plasma Filer" 'Check for the DWG 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) Dim oDef As SheetMetalComponentDefinition Set oDef = oDrawDoc.ComponentDefinition Dim oThick As String oThick = oDef.ActiveSheetMetalStyle.Thickness Dim oMaterial As String oMaterial = oDrawDoc.ActiveMaterial.DisplayName oFolder = oPath & "\" & oAsmName & " Plasma Filer\" & oThick & "-" & oMaterial 'Check for the DWG folder and create it if it does not exist If Len(Dir(oFolder, vbDirectory)) = 0 Then MkDir oFolder End If 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 'config 'Change values located here to change output. sOut = "FLAT PATTERN DWG?AcadVersion=2004" _ + "&OuterProfileLayer=Cut&OuterProfileLayerColor= 0;255;0" _ + "&InteriorProfilesLayer=Cut&InteriorProfilesLayerColor= 0;255;0" _ + "&FeatureProfilesLayer=Scribe&FeatureProfilesLayerColor= 255;0;255" _ + "&FeatureProfilesDownLayer=Scribe&FeatureProfilesDownLayerColor= 255;0;255" _ + "&InvisibleLayers=IV_BEND;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" _ '/config Dim Message, Title, Default, MyValue Message = "Enter a value between 1 and 1000" ' Set prompt. Title = "Add quantity" ' Set title. Default = "1" ' Set default. ' Display message, title, and default value. MyValue = InputBox(Message, Title, Default) Call oCompDef.DataIO.WriteDataToFile(sOut, oFolder & "\" & oAsmName & "-" & Mid(oFilename, 13) & "-" & MyValue & "pcs" & ".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
Solved! Go to Solution.