PDF-DXF-KROK z planu

Out of category
1

Witam
Udało mi się połączyć istniejące makra, które zebrałem z prawej i lewej strony.
Dzięki Wam moja praca jest o wiele łatwiejsza.

Udało mi się zrobić to makro z zarządzaniem indeksem, które pozwala uniknąć nadpisywania istniejącego indeksu, ale nie rozumiem, dlaczego .step nie działa w przypadku planu przeglądu i otwiera pierwszy element i wykonuje . Krok. Myślałem, że otworzę plik z pierwszego widoku planu.
Obchodzę problem, nie widząc go.

Muszą być w tym wszystkim drobne błędy lub niespójności, ale czuję, że dotykam rozwiązania.

Błąd jest w akapicie "przygotowanie 3D do STEP"

Dziękuję tym, dla których VBA jest językiem naturalnym. Podziwiam cię^^

saisissez ou collez d'PDF DXF & STEP indicé.swp - ------------10 / 11 / 2023'

Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swView          As SldWorks.View
Dim Filepath        As String
Dim FileName        As String
Dim boolstatus      As Boolean
Dim longstatus      As Long
Dim longwarnings    As Long
Dim swCustProp      As SldWorks.CustomPropertyManager
Dim Value           As String
Dim réponse         As Integer


Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' Vérifie si un plan est ouvert'
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

swApp.SendMsgToUser ("Seulement à partir d'un plan !!")

Exit Sub

End If

'-------------------------------------------------- Récupération de l'indice

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.GetFirstView 'Active le fond de plan
Set swView = swView.GetNextView 'Active la première vue après le fond de plan
Set swModel = swView.ReferencedDocument 'Récupère le fichier associé à la première vue
Set swModelDocExt = swModel.Extension
Set swCustProp = swModelDocExt.CustomPropertyManager("")
swCustProp.Get3 "Indice en cours", False, "", Value 'Récupération de la propriété "Indice en cours"

'-------------------------------------------------- Préparation du 3D pour STEP

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

Set swModel = swApp.ActiveDoc
Set myModelView = swModel.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "", False, longstatus
Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True
Set myModelView = swModel.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".step"

'--------------------------------------------------- Vérif avant écrasemant ou création'

If Len(Dir(Filepath & FileName)) = 0 Then

GoTo CréationEcrasement
Else
réponse = MsgBox("Ecraser l'existant", vbOKCancel + vbQuestion, "/!\ INDICE EXISTANT /!\")

If réponse = vbOK Then
GoTo CréationEcrasement
End If

If réponse = vbCancel Then
End If
Exit Sub

CréationEcrasement:

'-------------------------------------------------- Enregistrement du 3D en STEP

swModel.SaveAs3 Filepath & FileName & "", 0, 0

Set swModel = Nothing
swApp.CloseDoc ""
Set swModel = swApp.ActiveDoc


'-------------------------------------------------- Enregistrement du plan en PDF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".pdf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0


'-------------------------------------------------- Enregistrement du plan en DXF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".dxf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0

End If
End Sub


u code ici
2

Witam

Spróbuj tego w ten sposób:


Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = swView.GetReferencedModelName
swApp.ActivateDoc2 FileName, False, longstatus
Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True
Set myModelView = swModel.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".step"

Kod jest optymalizowalny, istnieją bezużyteczne wywołania funkcji, które mogą przeciążyć pamięć

1 polubienie
3

Tak, tak samo jak @Cyril_f
Robisz SetModel kilka razy, to jest problem.
Z tym kodem to działa, ale prawdopodobnie jest jeszcze trochę do zrobienia.
Plik debug.print pozwala zobaczyć nazwę bieżącego modelu w oknie edycji. (Aby skomentować lub usunąć później)


Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swView          As SldWorks.View
Dim Filepath        As String
Dim FileName        As String
Dim boolstatus      As Boolean
Dim longstatus      As Long
Dim longwarnings    As Long
Dim swCustProp      As SldWorks.CustomPropertyManager
Dim Value           As String
Dim réponse         As Integer


Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' Vérifie si un plan est ouvert'
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

swApp.SendMsgToUser ("Seulement à partir d'un plan !!")

Exit Sub

End If

'-------------------------------------------------- Récupération de l'indice

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.GetFirstView 'Active le fond de plan
Set swView = swView.GetNextView 'Active la première vue après le fond de plan
Set swModel = swView.ReferencedDocument 'Récupère le fichier associé à la première vue
Set swModelDocExt = swModel.Extension
 Debug.Print swModel.GetPathName & "  [" & swModel.Visible & "]"

Debug.Print "  " & swModel.GetTitle & " [" & swModel.GetType & "]"
Set swCustProp = swModelDocExt.CustomPropertyManager("")
swCustProp.Get3 "Indice en cours", False, "", Value 'Récupération de la propriété "Indice en cours"

'-------------------------------------------------- Préparation du 3D pour STEP

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
Debug.Print Filepath

'Set swModel = swApp.ActiveDoc
'Set myModelView = swModel.ActiveView
'myModelView.FrameState = swWindowState_e.swWindowMaximized
'swApp.ActivateDoc2 "", False, longstatus
'Set swModel = swApp.ActiveDoc
swModel.ClearSelection2 True
'Set myModelView = swModel.ActiveView
'myModelView.FrameState = swWindowState_e.swWindowMaximized

FileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".step"
Debug.Print FileName
'--------------------------------------------------- Vérif avant écrasemant ou création'

If Len(Dir(Filepath & FileName)) = 0 Then

GoTo CréationEcrasement
Else
réponse = MsgBox("Ecraser l'existant", vbOKCancel + vbQuestion, "/!\ INDICE EXISTANT /!\")

If réponse = vbOK Then
GoTo CréationEcrasement
End If

If réponse = vbCancel Then
End If
Exit Sub

CréationEcrasement:

'-------------------------------------------------- Enregistrement du 3D en STEP

swModel.SaveAs3 Filepath & FileName & "", 0, 0

Set swModel = Nothing
swApp.CloseDoc ""
Set swModel = swApp.ActiveDoc


'-------------------------------------------------- Enregistrement du plan en PDF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".pdf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0


'-------------------------------------------------- Enregistrement du plan en DXF

Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "-" & Value & ".dxf"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0

End If
End Sub

Ścieżka pliku jest przepisywana 3-4 razy z tą samą zawartością (czyli wartością) = bezużyteczne.
Dodaj debug.print, aby zobaczyć wartości zmiennych podczas uruchamiania w kroku, co bardzo ci pomoże.

1 polubienie
4

Dla mnie to bardziej problem polega na pamieniu ustawień. Ładuje proces programowy do pamięci kilka razy

2 polubienia
5

Zgadza się @Cyril.f , właściwie nie widziałem, aby skomentować wszystkie wiersze z wyjątkiem 1. z Set swApp.
Zestaw jest używany do inicjalizacji zmiennej, więc zwykle wystarczy 1 zestaw na zmienną.

2 polubienia
6

Dziękuję Państwu,

Jesteś na szczycie. To działa jak diabli!!
Trochę lepiej rozumiem, co zrobiłem.

pierwsze rozwiązanie zaproponowane przez Cyrila odblokowało mnie, ale teraz nie widać nawet otwartego 3D. Doskonały!

7

Dobra robota, wydawało mi się, że otwarcie pliku było konieczne/obowiązkowe do eksportu. Ale ponieważ jest ładowany do pamięci po otwarciu rysunku, można z niego zrezygnować.

1 polubienie