PDF-DXF-STEP vanuit een plan

Out of category
1

Hallo
Ik slaagde erin om bestaande macro's te combineren die ik van rechts en links verzamelde.
Dankzij jou is mijn werk veel gemakkelijker.

Het is me gelukt om deze macro te maken met een indexbeheer dat voorkomt dat een bestaande index wordt overschreven, maar ik begrijp niet waarom de .step niet werkt voor een overzichtsplan en het eerste stuk opent en de . Stap. Ik dacht dat ik het bestand zou openen vanaf de eerste weergave van het plan.
Ik ga om het probleem heen zonder het te zien.

Er moeten kleine fouten of inconsistenties in dit alles zitten, maar ik heb het gevoel dat ik de oplossing aanraak.

De fout zit in de paragraaf "het voorbereiden van de 3D voor STEP"

Dank aan degenen voor wie VBA een natuurlijke taal is. Ik bewonder je^^

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

Hallo

Probeer het zo:


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"

De code is te optimaliseren, er zijn nutteloze functieaanroepen die het geheugen kunnen overbelasten

1 like
3

Ja, hetzelfde als @Cyril_f
Je doet een SetModel meerdere keren, dat is een probleem.
Met deze code werkt het wel, maar er moet waarschijnlijk nog wel even opgeschoond worden.
Met debug.print kunt u de naam van het huidige model in het bewerkingsvenster zien. (Om later te reageren of te verwijderen)


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

Filepath wordt 3-4 keer herschreven met dezelfde inhoud (dus waarde) = nutteloos.
Voeg debug.print toe om de waarden van uw variabelen te zien terwijl u in stap loopt, dit zal u veel helpen.

1 like
4

Voor mij is het meer de set swapp die het probleem is. Het laadt het SW-proces meerdere keren in het geheugen

2 likes
5

Correct @Cyril.f , ik had eigenlijk niet gezien om commentaar te geven op alle regels behalve de 1e met Set swApp.
De set wordt gebruikt om je variabele te initialiseren, dus normaal gesproken is 1 set per variabele voldoende.

2 likes
6

Dank u wel heren,

Je staat bovenaan. Het werkt als de hel!!
Ik begrijp een beetje beter wat ik heb gedaan.

de eerste oplossing die door Cyril werd voorgesteld, had me gedeblokkeerd, maar nu kun je de 3D niet eens open zien. Perfect!

7

Goed gedaan, het leek mij dat het openen van het bestand noodzakelijk/verplicht was om te exporteren. Maar omdat het bij het openen van de tekening met geheugen wordt beladen, kan het achterwege blijven.

1 like