Witam Przepraszam wracając do tego tematu byłem nieobecny 2 miesiące i temat, który otworzyłem, nie został rozwiązany.
Mam problem z zawiesiną makro.
Kiedy go używam, mam plik o nazwie XXXXXD05 , a kiedy kopiuję go za pomocą makra, zamienia się w xxxxxd05 .
to tak, jakbym miał plik o nazwie "OrAngE" i zapisał go pod nazwą "pomarańczowy", ale nie mogę znaleźć, jak powiedzieć mu, aby zachował oryginalny format.
Próbowałem umieścić tekst porównania, ale to nic nie zmienia
Oto trochę mojego makra.
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
Miałem ten jako bazę
http://help.solidworks.com/2015/English/api/sldworksapi/Pack_and_Go_an_Assembly_Example_VB.htm
Witam
po kilku testach mam wrażenie, że będzie to trudne do rozwiązania za pomocą funkcji od "GetPackAndGo", funkcja "GetDocumentNames" wydaje się zwracać nazwy, które są systematycznie pisane małymi literami...
Pozdrowienia
1 polubienie
Niestety, jeśli nie przejdę przez Get pack and go, wydaje mi się, że powoduje to późniejsze problemy z odniesieniami.
Twoim zdaniem nazwa części jest więc źle odzyskana, problem może pojawić się później, "Wymień" lub "SavePackAndGo"
Funkcja zamiany nie będzie na tym grać??
Replace(wyrażenie, znajdź, zamień, [początek], [liczba], [porównaj])
https://excel-malin.com/tutoriels/vba-fonctions/replace/
Niestety, po chwili zajrzenia do środka wydaje mi się, że pochodzi on z "Getdocumentnames"
FYI, kompozycja na wynos zawsze zmieniała wielkość liter w nazwach plików i to od wersji pamięci z 2004 roku, w której już zmieniła rozszerzenie z SLDPRT na sldprt. Wszystko to z pamięci, ale wiem, że w tamtym czasie przeszkadzało nam oprogramowanie z pakietu MYCAD, które w przeciwieństwie do windowsa robiło różnicę między tymi 2 przerwami w rozszerzeniu.
2 polubienia
Okej, dziękuję za informacje, które zawsze są przydatne po mojej stronie, obecnie mamy "launch skopiowany z projektu", który zachowuje wielkość liter części, zastępując pierwsze 5 znaków 5 innymi, może mnie to zainteresować , dlatego myślę, że mogę pobawić się funkcją "Zamień", ale nie wiem Nie w jaki sposób.
dlatego zastanawiam się, czy GetDocumentSaveToNames nie bierze pod uwagę małych i wielkich liter.
Lub jeśli jest to wtedy, gdy używam funkcji zamiany , wszystko jest pisane małymi literami.
Witam
Śledząc, co dzieje się na każdym kroku, zdajemy sobie sprawę, że problem pojawia się zaraz po wywołaniu funkcji "GetDocumentNames", która jest przed funkcją "Zamień", która nie ma nic wspólnego z problemem.
Pozdrowienia
1 polubienie
A po prostu usuwając funkcję "Zamień" z makra, problem nadal występuje ...
1 polubienie
Próbowałem rzeczywiście, problem jest tutaj
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
W szczególności
' 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
Dalej szukam, czy ktoś ma jakiś pomysł, jestem zainteresowany.
Pozdrowienia.
Być może znalazłem rozwiązanie, że jeśli dodam kod tego typu na końcu mojego makra, aby zmienić nazwę wszystkiego wielkimi literami, czy myślisz, że moje referencje będą podążać w 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
To nie rozwiązuje problemu mieszania wielkich i wielkich liter, jak w twoim przykładzie ze słowem "OrAngE", będziesz mieć wszystko wielkimi literami zamiast wszystkiego małymi literami.
Pozdrowienia
Tak, niestety nie mogę znaleźć żadnego rozwiązania, więc dodałem fragment kodu, który przechodzi przez okna, aby zmienić nazwy moich części wielką literą, mam tylko jeden problem polega na tym, że moje części są pisane wielkimi literami.
ale kiedy otwieram Solidworks, są one pisane małymi literami 
Nie jest to złamanie , które chciałem mieć, ale moim zdaniem nie mam wyboru... :/
Nie rozumiem, dlaczego przechodzisz przez system Windows, aby zmienić nazwy swoich części wielkimi literami, po prostu musisz wpisać:
For i = 0 To (namesCount - 1)
pgFileNames(i) = Replace(pgFileNames(i), pgFileNames(i), UCase(pgFileNames(i)))
Next i
Przed Twoimi liniami:
myPath = " chemin du dossier "
status = swPackAndGo.SetSaveToName(True, myPath)
Następnie, gdy otworzysz swój zespół z PackAnGo, sprawdź, czy początkowy zespół jest zamknięty, w przeciwnym razie Solidworks może odwoływać się do starego złożenia, a nie do nowego, ponieważ nie jest rozróżniana wielkość liter.
Pozdrowienia