×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Contact US

*
*
*
*

Thanks. We have received your request and will respond promptly.

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Save As Macro Issue

thread560-484038

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.

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

This is how "Save As" command works, isnt't it? If so, don't expect it's behaviour to be different in macro.

I guess you have to start from the bottom (leaf) components of your assembly.

RE: Save As Macro Issue

(OP)
So how would you recommend saving them with a Macro so I dont have this problem?

RE: Save As Macro Issue

Replace "for 1..count" loop with backwards iterator:

X=sel.Count
Do while x > 0
...
X=X-1
Loop

RE: Save As Macro Issue

(OP)
I tried both of your recommendations.

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?

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members! Already a Member? Login

Resources

Low-Volume Rapid Injection Molding With 3D Printed Molds
Learn methods and guidelines for using stereolithography (SLA) 3D printed molds in the injection molding process to lower costs and lead time. Discover how this hybrid manufacturing process enables on-demand mold fabrication to quickly produce small batches of thermoplastic parts. Download Now
Design for Additive Manufacturing (DfAM)
Examine how the principles of DfAM upend many of the long-standing rules around manufacturability - allowing engineers and designers to place a part’s function at the center of their design considerations. Download Now
Taking Control of Engineering Documents
This ebook covers tips for creating and managing workflows, security best practices and protection of intellectual property, Cloud vs. on-premise software solutions, CAD file management, compliance, and more. Download Now
Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close