Saving parts and sheet metal parts to different folders

Saving parts and sheet metal parts to different folders

JorisSteurs1246
Advocate Advocate
784 Views
5 Replies
Message 1 of 6

Saving parts and sheet metal parts to different folders

JorisSteurs1246
Advocate
Advocate

 I've put some code together with the intention  to save sheetmetal parts to the sheetmetal folder and normal parts to the parts folder.

So the code works well for a sheetmetal part but gives an error in a normal part.

I was assuming that because the normal part doesn't have a flatpattern that the code would run accordingly , but i'm afraid that was a too simple approach.

I could not find any other references about how to differentiate parts between sheet metal parts, so any help is really appreciated 🙂

 

Code right now as follow:

 

 

'**** Find path of the project
'[
Dim IPJ as String
Dim IPJ_Name As String
Dim IPJ_Path As String
Dim FNamePos As Long
'set a reference to the FileLocations object.
IPJ = ThisApplication.FileLocations.FileLocationsFile
'get the location of the last backslash seperator
FNamePos = InStrRev(IPJ, "\", -1)    
'get the project file name with the file extension
IPJ_Name = Right(IPJ, Len(IPJ) - FNamePos)
'get the project name (without extension)
IPJ_ShortName = Left(IPJ_Name, Len(IPJ_Name) - 4)
'get the path of the folder containing the project file
IPJ_Folder_Location = Left(IPJ, Len(IPJ) - Len(IPJ_Name))
']

' **** Read text from .txt files in the settings folder 
'[
oRead1 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\Jobnumber.txt")
Jobnumber = oRead1.ReadLine()
oRead2 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\Project.txt")
Project = oRead2.ReadLine()
oRead3 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\SO_number.txt")
SO_number = oRead3.ReadLine()
oRead4 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\Company.txt")
Company = oRead4.ReadLine()
']

oPN = iProperties.Value("Project", "Part Number")

'*** Save/ make folders and place document with PN as filename in correct folder
'[ 
Dim oPath As String
Dim oFolderPRT As String
Dim oFolderSM_PRT As String
oPath = ThisDoc.WorkspacePath
oFolderPRT = (oPath & "\Output\" & Jobnumber & "\Parts\")
oFolderSM_PRT = (oPath & "\Output\" & Jobnumber & "\SheetMetalParts\")
'***Check for the folders and create them if they don't not exist.
If Not System.IO.Directory.Exists(oFolderPRT) Then
    System.IO.Directory.CreateDirectory(oFolderPRT)
End If

If Not System.IO.Directory.Exists(oFolderSM_PRT) Then
    System.IO.Directory.CreateDirectory(oFolderSM_PRT)
End If

'*** Save copy of active document

'ThisDoc.Document.SaveAs(oFolder & oPN & ".ipt" , True)
Dim oDoc As PartDocument
oDoc = ThisApplication.ActiveDocument
    'ensure this part has a flat pattern
Dim oSMDef As SheetMetalComponentDefinition
oSMDef = oDoc.ComponentDefinition

i = MessageBox.Show("Part saved as Sheetmetal ONLY if Flatpattern is generated but NOT active", "Please confirm! ",MessageBoxButtons.YesNo,MessageBoxIcon.Question)
If i = vbYes Then
Goto Yes
Else If i = vbNo Then 
Goto NO
End If 

Yes:

If oSMDef.FlatPattern Is Nothing Then 
'Save in Parts folder
ThisDoc.Document.SaveAs(oFolderPRT & oPN & ".ipt" , True)
MessageBox.Show("File: " & oPN & ".ipt"& vbLf & "Succesfully saved in : " & oFolderPRT , "Succes")
'Goto Endrule
Else
ThisDoc.Document.SaveAs(oFolderSM_PRT & oPN & ".ipt" , True)
End If
Goto Endrule
NO:MessageBox.Show("No Files are saved!", "ERROR")
Endrule:  
 

']

 

 

0 Likes
Accepted solutions (1)
785 Views
5 Replies
Replies (5)
Message 2 of 6

frederik_vollbrecht
Advocate
Advocate
Accepted solution

Hi,

 

you could use

 

iProperties.Value("Project", "Document SubType Name")="Sheet Metal"

for seperation, predefined in the SM-Template.

 

 

Would look like this:

 

 

If iProperties.Value("Project", "Document SubType Name")<>"Sheet Metal" then
'Save in Parts folder
ThisDoc.Document.SaveAs(oFolderPRT & oPN & ".ipt" , True)
MessageBox.Show("File: " & oPN & ".ipt"& vbLf & "Succesfully saved in : " & oFolderPRT , "Succes")
'Goto Endrule
Else
ThisDoc.Document.SaveAs(oFolderSM_PRT & oPN & ".ipt" , True)
End If
Goto Endrule
NO:MessageBox.Show("No Files are saved!", "ERROR")
Endrule:  

 

Message 3 of 6

rjay75
Collaborator
Collaborator

Use the DocumentType and the DocumentSubType properties. The component definition for non sheet metal parts do not have the sheet metal properties like HasFlatPattern on it so you can't test for it.

 

'Test to see if we are on a part document.
If
ThisDoc.Document.DocumentType = kPartDocumentObject Then
Dim isSheetMetal As Boolean = False 'Is this a sheet metal document using the SubType ID for sheetmetal. If ThisDoc.Document.DocumentSubType.DocumentSubTypeID.Equals("{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}") Then Dim smComp As SheetMetalComponentDefinition = ThisDoc.Document.ComponentDefinition
isSheetMetal = smComp.HasFlatPattern End If

If isSheetMetal Then
'Do Sheet Metal Stuff

Else
'Do Part Stuff

End If
End If

 

0 Likes
Message 4 of 6

JorisSteurs1246
Advocate
Advocate

Thank you Rodney, your contribution will be usefull to tackle other problems, but for this rule I got it working using the subtype in the properites.

I post ,the working code so the community can make use of it. 

Thanks

 

Joris

0 Likes
Message 5 of 6

JorisSteurs1246
Advocate
Advocate

Thank you Frederik to point me to this iprop.

Never used this before and was unaware this could be used, 

This property changes instantly when switching from part to SM and back .

So this works perfectly.

I'll post the working code also so that the community can make use of it.

Thanks again for your valued contribution.

Joris

 

0 Likes
Message 6 of 6

JorisSteurs1246
Advocate
Advocate

And here is the code

 

 

'**** Find path of the project
'[
Dim IPJ as String
Dim IPJ_Name As String
Dim IPJ_Path As String
Dim FNamePos As Long
'set a reference to the FileLocations object.
IPJ = ThisApplication.FileLocations.FileLocationsFile
'get the location of the last backslash seperator
FNamePos = InStrRev(IPJ, "\", -1)    
'get the project file name with the file extension
IPJ_Name = Right(IPJ, Len(IPJ) - FNamePos)
'get the project name (without extension)
IPJ_ShortName = Left(IPJ_Name, Len(IPJ_Name) - 4)
'get the path of the folder containing the project file
IPJ_Folder_Location = Left(IPJ, Len(IPJ) - Len(IPJ_Name))
']

' **** Read text from .txt files in the settings folder 
'[
oRead1 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\Jobnumber.txt")
Jobnumber = oRead1.ReadLine()
oRead2 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\Project.txt")
Project = oRead2.ReadLine()
oRead3 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\SO_number.txt")
SO_number = oRead3.ReadLine()
oRead4 = System.IO.File.OpenText(IPJ_Folder_Location & "\Settings\Company.txt")
Company = oRead4.ReadLine()
']

oPN = iProperties.Value("Project", "Part Number")

'*** Save/ make folders and place document with PN as filename in correct folder
'[ 
Dim oPath As String
Dim oFolderPRT As String
Dim oFolderSM_PRT As String
oPath = ThisDoc.WorkspacePath
oFolderPRT = (oPath & "\Output\" & Jobnumber & "\Parts\")
oFolderSM_PRT = (oPath & "\Output\" & Jobnumber & "\SheetMetalParts\")
'***Check for the folders and create them if they don't not exist.
If Not System.IO.Directory.Exists(oFolderPRT) Then
    System.IO.Directory.CreateDirectory(oFolderPRT)
End If

If Not System.IO.Directory.Exists(oFolderSM_PRT) Then
    System.IO.Directory.CreateDirectory(oFolderSM_PRT)
End If

'*** Save copy of active document

'ThisDoc.Document.SaveAs(oFolder & oPN & ".ipt" , True)

Dim FileType As String

If  iProperties.Value("Project", "Document SubType Name")="Sheet Metal" Then
FileType = "SM"
ElseIf iProperties.Value("Project", "Document SubType Name")="Modeling"  Then
FileType = "PRT"
Else
FileType = "NA"
End If




i = MessageBox.Show("Part saved as Sheetmetal ONLY if Flatpattern is generated but NOT active", "Please confirm! ",MessageBoxButtons.YesNo,MessageBoxIcon.Question)
If i = vbYes Then
Goto Yes
Else If i = vbNo Then 
Goto NO
End If 

Yes:

Select Case FileType
 
 Case  "SM"
     Dim oDoc As PartDocument
    oDoc = ThisApplication.ActiveDocument
    'ensure this part has a flat pattern
    Dim oSMDef As SheetMetalComponentDefinition
    oSMDef = oDoc.ComponentDefinition
    If oSMDef.FlatPattern Is Nothing Then 
    MessageBox.Show("File: " & oPN & ".ipt"& vbLf & " -- Flat pattern Not Found! " , "Problem")
    Goto NO  'Goto Error message
    Else
    ThisDoc.Document.SaveAs(oFolderSM_PRT & oPN & ".ipt" , True)
    MessageBox.Show("File: " & oPN & ".ipt"& vbLf & "Succesfully saved in : " & oFolderSM_PRT , "Succes")
    End If
 Case "PRT"
'Save in Parts folder
ThisDoc.Document.SaveAs(oFolderPRT & oPN & ".ipt" , True)
MessageBox.Show("File: " & oPN & ".ipt"& vbLf & "Succesfully saved in : " & oFolderPRT , "Succes")
 Case "NA"
     MessageBox.Show("File is not part or Sheet Metal. No Files are saved!", "ERROR")
    Goto NO  'Goto Error message
End Select

Goto Endrule
NO:MessageBox.Show("No Files are saved!", "ERROR")
Endrule:  
 

']