Hello Sorry to come back to this subject I was absent 2 months and the topic I had opened is not solved.
I have a problem with a macro slurry.
When I use it I have a file named XXXXXD05 and when I copy it via my macro it turns into xxxxxd05 .
it's like if I had a file named "OrAngE" and I saved it under the name "orange", but I can't find how to tell it to keep the original format.
I tried to put a compare text but it doesn't change anything
Here's a bit of my macro.
Option Explicit
Option Compare Text ' ne prend pas compte du fait des majuscule "XXXXX"="xxxxx"
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim DerligneOuvre As Integer
Dim DerligneFerme As Integer
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim openFile As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim pgGetFileNames As Variant
Dim pgDocumentStatus As Variant
Dim status As Boolean
Dim Warnings As Long
Dim Errors As Long
Dim i As Long
Dim namesCount As Long
Dim myPath As String
Dim statuses As Variant
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Drive
Dim oFl As Folder
Public Function DossierExiste(MonDossier As String)
If Len(Dir(MonDossier, vbDirectory)) > 0 Then
DossierExiste = True
Else
DossierExiste = False
End If
End Function
' ----------------------------------------------------création dossier---------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
If TextBox1.value = "" Then
MsgBox "mettre un numero de dossier"
Exit Sub
End If
'creer un repertoire affaire
Dim MonDossier As String
Sheets("CopieDeProjet").Range("F2") = TextBox1.value
MonDossier = Sheets("CopieDeProjet").Range("F4")
If DossierExiste(MonDossier) = True Then
MsgBox "Le dossier existe... prendre un numero non utiliser"
Exit Sub
Else
MsgBox "dossier creer..."
MkDir Sheets("CopieDeProjet").Range("F4")
End If
'----------------------------------------------------enregistrement assemblage-----------------------------------------------------------------------------------------
Set swApp = CreateObject("SldWorks.application")
Set Part = swApp.ActiveDoc
boolstatus = Part.ForceRebuild3(True)
boolstatus = Part.Save2(False)
Set swModelDoc = swApp.ActiveDoc
Set swModelDocExt = swModelDoc.Extension
Part.ClearSelection2 True
Part.EditRebuild3
'---------------------------------------------------------debut copie-----------------------------------------------------------------------------------------------------
Set swApp = CreateObject("SldWorks.Application")
' Get Pack and Go object
Set swPackAndGo = swModelDocExt.GetPackAndGo
' Get number of documents in assembly
namesCount = swPackAndGo.GetDocumentNamesCount
' Include any drawings, SOLIDWORKS Simulation results, and SOLIDWORKS Toolbox components
swPackAndGo.IncludeDrawings = True
swPackAndGo.IncludeSimulationResults = False
swPackAndGo.IncludeToolboxComponents = False
' Get current save-to paths and filenames of the assembly's documents
status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus)
' Set document paths and names for Pack and Go
For i = 0 To (namesCount - 1)
If InStr(pgFileNames(i), "34980") <> 0 Then
pgFileNames(i) = Replace(pgFileNames(i), "34980", "34950")
Else
pgFileNames(i) = ""
End If
Next i
status = swPackAndGo.SetDocumentSaveToNames(pgFileNames)
' Set folder where to save the files
myPath = " chemin du dossier "
status = swPackAndGo.SetSaveToName(True, myPath)
' Flatten the Pack and Go folder structure; save all files to the root directory
swPackAndGo.FlattenToSingleFolder = True
' Pack and Go
statuses = swModelDocExt.SavePackAndGo(swPackAndGo)
End sub
after a few tests I have the impression that this will be difficult to solve via the functions from "GetPackAndGo", the "GetDocumentNames" function seems to return names that are systematically lowercase...
FYI, a takeaway composition has always changed the case of the filenames and this since the 2004 version of memory where it already changed the extension from SLDPRT to sldprt. All this from memory but I know that we were bothered at the time with a software from the MYCAD suite which unlike windows made the difference between these 2 extension breaks.
Okay thank you for the information it's always useful on my side currently we have "launch copied from project" which keeps the case of the parts by replacing the first 5 characters with 5 others, it may interest me that's why I guess I can play with the "Replace" function but I don't know not how.
that's why I'm wondering if GetDocumentSaveToNames doesn't take into account lowercase and uppercase.
Or if it's when I use the replace function that everything goes lowercase.
By tracing what happens at each step we realize that the problem occurs as soon as the "GetDocumentNames" function is called, which is upstream of the "Replace" function which has nothing to do with the problem.
Option Explicit
Option Compare Text ' ne prend pas compte du fait des majuscule "XXXXX"="xxxxx"
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim DerligneOuvre As Integer
Dim DerligneFerme As Integer
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swPackAndGo As SldWorks.PackAndGo
Dim openFile As String
Dim pgFileNames As Variant
Dim pgFileStatus As Variant
Dim pgGetFileNames As Variant
Dim pgDocumentStatus As Variant
Dim status As Boolean
Dim Warnings As Long
Dim Errors As Long
Dim i As Long
Dim namesCount As Long
Dim myPath As String
Dim statuses As Variant
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Drive
Dim oFl As Folder
Public Function DossierExiste(MonDossier As String)
If Len(Dir(MonDossier, vbDirectory)) > 0 Then
DossierExiste = True
Else
DossierExiste = False
End If
End Function
' ----------------------------------------------------création dossier---------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
If TextBox1.value = "" Then
MsgBox "mettre un numero de dossier"
Exit Sub
End If
'creer un repertoire affaire
Dim MonDossier As String
Sheets("CopieDeProjet").Range("F2") = TextBox1.value
MonDossier = Sheets("CopieDeProjet").Range("F4")
If DossierExiste(MonDossier) = True Then
MsgBox "Le dossier existe... prendre un numero non utiliser"
Exit Sub
Else
MsgBox "dossier creer..."
MkDir Sheets("CopieDeProjet").Range("F4")
End If
'----------------------------------------------------enregistrement assemblage-----------------------------------------------------------------------------------------
Set swApp = CreateObject("SldWorks.application")
Set Part = swApp.ActiveDoc
boolstatus = Part.ForceRebuild3(True)
boolstatus = Part.Save2(False)
'longstatus = Part.SaveAs3(Sheets("CopieDeProjet").Range("F3") & "\" & Sheets("CopieDeProjet").Range("E2") & ".SLDASM", 0, 2)
'Set Part = Nothing
'swApp.CloseDoc Sheets("CopieDeProjet").Range("E2") & ".SLDASM"
'Set Part = swApp.OpenDoc6(Sheets("CopieDeProjet").Range("F3") & "\" & Sheets("CopieDeProjet").Range("E2") & ".SLDASM", 2, 0, "", longstatus, longwarnings)
'Set Part = swApp.ActiveDoc
'Part.ClearSelection2 True
'Part.EditRebuild3
Set swModelDoc = swApp.ActiveDoc
Set swModelDocExt = swModelDoc.Extension
Part.ClearSelection2 True
Part.EditRebuild3
'---------------------------------------------------------debut copie-----------------------------------------------------------------------------------------------------
Set swApp = CreateObject("SldWorks.Application")
' Get Pack and Go object
Set swPackAndGo = swModelDocExt.GetPackAndGo
' Get number of documents in assembly
namesCount = swPackAndGo.GetDocumentNamesCount
' Include any drawings, SOLIDWORKS Simulation results, and SOLIDWORKS Toolbox components
swPackAndGo.IncludeDrawings = True
swPackAndGo.IncludeSimulationResults = False
swPackAndGo.IncludeToolboxComponents = False
' Get current paths and filenames of the assembly's documents
status = swPackAndGo.GetDocumentNames(pgFileNames)
Debug.Print ""
Debug.Print " Current path and filenames: "
If (Not (IsEmpty(pgFileNames))) Then
For i = 0 To UBound(pgFileNames)
Debug.Print " The path and filename is: " & pgFileNames(i)
Next i
End If
' Get current save-to paths and filenames of the assembly's documents
status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus)
Debug.Print ""
Debug.Print " Current default save-to filenames: "
If (Not (IsEmpty(pgFileNames))) Then
For i = 0 To UBound(pgFileNames)
Debug.Print " The path and filename is: " & pgFileNames(i)
Next i
End If
In particular, the
' Get current paths and filenames of the assembly's documents
status = swPackAndGo.GetDocumentNames(pgFileNames)
Debug.Print ""
Debug.Print " Current path and filenames: "
If (Not (IsEmpty(pgFileNames))) Then
For i = 0 To UBound(pgFileNames)
Debug.Print " The path and filename is: " & pgFileNames(i)
Next i
End If
' Get current save-to paths and filenames of the assembly's documents
status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus)
Debug.Print ""
Debug.Print " Current default save-to filenames: "
If (Not (IsEmpty(pgFileNames))) Then
For i = 0 To UBound(pgFileNames)
Debug.Print " The path and filename is: " & pgFileNames(i)
Next i
End If
I may have found a solution that if I add a code of this type at the end of my macro to rename everything in capital letters, do you think that my references will follow in sw??
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ReDim pgGetFileNames(namesCount - 1)
ReDim pgDocumentStatus(namesCount - 1)
status = swPackAndGo.GetDocumentSaveToNames(pgGetFileNames, pgDocumentStatus)
' Pack and Go
statuses = swModelExt.SavePackAndGo(swPackAndGo)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Add the following lines after Pack and go command
For i = 0 To (namesCount - 1) '''''''''''''change lowecase to uppercase
Name pgGetFileNames(i) As UCase(pgGetFileNames(i)) ' Rename file.
If (Right(UCase(pgGetFileNames(i)), 7) = ".SLDPRT") Then
DRAW = Replace(UCase(pgGetFileNames(i)), "SLDPRT", "SLDDRW")
If Dir(DRAW) <> "" Then Name DRAW As UCase(DRAW)
End If
Next i
This doesn't solve the problem of mixing lowercase and uppercase as in your example with the word "OrAngE", you'll have everything in uppercase instead of everything in lowercase.
Yes unfortunately I can't find any solution so I added a piece of code that goes through windows to rename my parts in capital I only have one problem is that my parts are in capital letters.
but when I open Solidworks they are lowercase
It's not the breakage I wanted to have but I have no choice in my opinion ... :/
I don't see why you go through Windows to rename your parts in capital letters, you just have to put:
For i = 0 To (namesCount - 1)
pgFileNames(i) = Replace(pgFileNames(i), pgFileNames(i), UCase(pgFileNames(i)))
Next i
Before your lines:
myPath = " chemin du dossier "
status = swPackAndGo.SetSaveToName(True, myPath)
And then when you open your assembly from the PackAnGo, check that your initial assembly is closed, otherwise Solidworks may refer to the old assembly rather than the new one because it is not case sensitive.
