Save As Macro Issue
Save As Macro Issue
(OP)
I have written the Macro shown below and have ran into an issue I can't figure out.
When I run the Macro and change the save location to a new folder, it saves all the parts and products to the new folder exactly like I need.
But during this, it saves some of the parts in the old location,overwriting them, before saving them to the new location.
I need to modify my code in a way to prevent it from ever saving over the original location files if I have specified a new directory.
When I run the Macro and change the save location to a new folder, it saves all the parts and products to the new folder exactly like I need.
But during this, it saves some of the parts in the old location,overwriting them, before saving them to the new location.
I need to modify my code in a way to prevent it from ever saving over the original location files if I have specified a new directory.
CODE --> .CATScript
Sub CATMain() Dim noSymPartName As String Dim noSymProductName As String Dim newCharacter As String newCharacter = "_" CATIA.DisplayFileAlerts = False Set oDocs = CATIA.Documents docPath = oDocs.Item(1).Path changePath = MsgBox("Current save location is: " & vbNewLine & vbNewLine & docPath & vbNewLine & vbNewLine & " Would you like to change file path?", vbYesNo, "Current Save Location") If changePath = vbYes Then Const WINDOW_HANDLE = 0 Const NO_OPTIONS = &H0001 'Const File_Path = "\\GTFS1\Share\Data\" Const File_Path = 17 Set objShell = CreateObject("Shell.Application") 'Set objFolder = objShell.BrowseForFolder _ ' (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, docPath) Set objFolder = objShell.BrowseForFolder _ (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, File_Path) Set objFolderItem = objFolder.Self 'objPath = objFolderItem.Path docPath = objFolderItem.Path If MsgBox("This is the new location the open product will save:" & vbNewLine & vbNewLine & docPath & vbNewLine & vbNewLine & "Is this the correct location?", vbYesNo, "Save Location") = vbNo Then MsgBox "Pick a New Save Location",, "Changing Save Location" Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder _ (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, File_Path) Set objFolderItem = objFolder.Self docPath = objFolderItem.Path End If 'Else ' If changePath = vbNo Then 'docPath = docPath 'Set objFolderItem = CreateObject("Scripting.FileSystemObject") 'docPath = InputBox("Enter new file path", "File path") End If CATIA.RefreshDisplay = False 'Search Assembly For Parts/Products Dim sel As Selection Set sel = CATIA.ActiveDocument.Selection sel.Search "CATAsmSearch.Product,all" For X = 1 To sel.Count 'Checking To See If Current Item X is a Product If Right(sel.Item(X).LeafProduct.ReferenceProduct.Parent.Name, 7) = "Product" Then Set oDoc1 = sel.Item(X).LeafProduct.ReferenceProduct.Parent Set oProduct1 = oDoc1.Product 'For x = 1 To oDocs.Count 'If TypeName(oDocs.Item(x)) = "ProductDocument" Then 'Set oDoc1 = oDocs.Item(x) 'Set oProduct1 = oDoc1.Product noSymProductName = oProduct1.PartNumber 'get the current PartNumber noSymProductName = Replace(noSymProductName,".","") noSymProductName = Replace(noSymProductName,",","") noSymProductName = Replace(noSymProductName,"(","") noSymProductName = Replace(noSymProductName,")","") noSymProductName = Replace(noSymProductName,"/","") noSymProductName = Replace(noSymProductName,"\","") noSymProductName = Replace(noSymProductName,"#","") noSymProductName = Replace(noSymProductName,"$","") noSymProductName = Replace(noSymProductName,"%","") noSymProductName = Replace(noSymProductName,"*","") oDoc1.SaveAs docPath & "\" & noSymProductName & ".CATProduct" End If If Right(sel.Item(X).LeafProduct.ReferenceProduct.Parent.Name, 4) = "Part" Then Set oDoc2 = sel.Item(X).LeafProduct.ReferenceProduct.Parent Set oPart1 = oDoc2.Product 'Next 'x 'For v = 1 To oDocs.Count 'If TypeName(oDocs.Item(v)) = "PartDocument" Then 'Set oDoc2 = oDocs.Item(v) 'Set oPart1 = oDoc2.Product noSymPartName = oPart1.PartNumber 'get the current PartNumber noSymPartName = Replace(noSymPartName,".","") noSymPartName = Replace(noSymPartName,",","") noSymPartName = Replace(noSymPartName,"(","") noSymPartName = Replace(noSymPartName,")","") noSymPartName = Replace(noSymPartName,"/","") noSymPartName = Replace(noSymPartName,"\","") noSymPartName = Replace(noSymPartName,"#","") noSymPartName = Replace(noSymPartName,"$","") noSymPartName = Replace(noSymPartName,"%","") noSymPartName = Replace(noSymPartName,"*","") oDoc2.SaveAs docPath & "\" & noSymPartName & ".CATPart" 'On Error Resume Next End If Next 'x 'Next 'v CATIA.RefreshDisplay = True Msgbox "Save Finished!",,"SAVE FINISH!" Msgbox "YOU HAVE TO USE SAVE MANAGEMENT NOW!",,"YOU HAVE TO USE SAVE MANAGEMENT NOW!" End Sub
RE: Save As Macro Issue
I guess you have to start from the bottom (leaf) components of your assembly.
RE: Save As Macro Issue
RE: Save As Macro Issue
https://www.eng-tips.com/viewthread.cfm?qid=326907
regards,
LWolf
RE: Save As Macro Issue
X=sel.Count
Do while x > 0
...
X=X-1
Loop
RE: Save As Macro Issue
LWolf,
After doing enough research to setup my Macro correctly for Send To, I get an error that the method "SetInitialFile" failed, and from my googling, I think its because I do not have the PX1 license, so i can't run Send To through a Macro.
Little Cthulhu,
This took awhile, since I had never even seen the "Do While" command, which i must say is pretty cool.
But this still leaves two products being saved in the original location before they are Saved in their new location, which overwrites files I do not want to overwrite.
Any more advice?