Hallo
Da ich keine Ahnung vom Programmieren habe, brauche ich Hilfe, um ein Makro auf SolidWorks zu entwickeln, das es ermöglicht, eine PDF-, DXF- und eine Step-Datei über eine Zeichnung zu erstellen.
Ich möchte auch in der Lage sein, PDFs mit dem Namen des Teils zu speichern, ohne Änderungen vorzunehmen.
Danke, dass du mir geholfen hast
Vielleicht wird diese Art von Makro in der Antwort auf eine ähnliche Frage vorgestellt
http://www.lynkoa.com/forum/cao/macro-d-enregistrement-en-pdf-et-dxf-dans-un-dossier-externe
4 „Gefällt mir“
Hallo
Nach einiger Recherche habe ich einen Makrobefehl gefunden, mit dem ich aus der Zeichnung eine PDF- und DXF-Datei erstellen kann.
Ich muss zu diesem Befehl einen Code hinzufügen, um eine Stufe mehr aus dem Raum zu erstellen, das einzige Problem ist, dass ich keine Ahnung habe, was ich hinzufügen soll.
Ein wenig Hilfe wäre willkommen.
Hallo
Stellen Sie das Makro zur Verfügung, wir sagen Ihnen, was fehlt.
1 „Gefällt mir“
Dank dieses Makrobefehls habe ich es geschafft, in PDF und DXF zu speichern
Dim swApp als SldWorks.SldWorks
Dim swModel As ModelDoc2
Fehler so lange dimmen
Dim lWarnungen so lange
Sub main()
Legen Sie swApp = Application.SldWorks fest
Festlegen von swModel = swApp.ActiveDoc
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " " & swModel.GetCustomInfoValue("", "Review") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nichts, lErrors, lWarnungen
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " " & swModel.GetCustomInfoValue("", "Revision") & ".dxf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nichts, lErrors, lWarnungen
Ende Sub
Funktion GetFilename(strPath als Zeichenfolge) als Zeichenkette
Dim strTemp As String
strTemp = Mid$(strPfad, InStrRev(strPfad, "\") + 1)
GetFilename = Links$(strTemp, InStrRev(strTemp, ".") - 1)
Ende-Funktion
Hallo
Im Anhang befindet sich der entsprechende Code
Option Explicit
Public Enum swDocumentTypes_e
swDocNONE = 0 ' Used to be TYPE_NONE
swDocPART = 1 ' Used to be TYPE_PART
swDocASSEMBLY = 2 ' Used to be TYPE_ASSEMBLY
swDocDRAWING = 3 ' Used to be TYPE_DRAWING
End Enum
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swConfig As SldWorks.Configuration
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim I As Long
Dim nDocType As Long
Dim op As Long
Dim suppr As Long
Dim lErrors As Long
Dim lWarnings As Long
Dim boolstatus As Boolean
Dim bRet As Boolean
Dim FileConnu As Boolean
Dim nbConnu As Integer
Dim sModelName As String
Dim sPathName As String
Dim TabConnu(10000) As String
Dim sConfigName As String
Sub Main()
Set swApp = Application.SldWorks
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepAP, 214) 'Force la version AP214
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepExportPreference, swAcisOutputGeometryPreference_e.swAcisOutputAsSolidAndSurface) 'Force l'export en format Solid/Surface Geometry
Set swModel = swApp.ActiveDoc
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " " & swModel.GetCustomInfoValue("", "Révision") & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
swModel.Extension.SaveAs GetFilename(swModel.GetPathName) & " " & swModel.GetCustomInfoValue("", "Révision") & ".dxf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
Call ExportStep
End Sub
Function GetFilename(strPath As String) As String
Dim strTemp As String
strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
GetFilename = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function
Sub ExportStep()
Set swDraw = swModel
vSheetName = swDraw.GetSheetNames
vSheetNameArr = swDraw.GetSheetNames
For Each vSheetName In vSheetNameArr
bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
Set swView = swDraw.GetFirstView 'Sélectionne le fond de plan
Set swView = swView.GetNextView 'Passe à la vue suivante pour exclure le fond de plan
While Not swView Is Nothing
' Determine if this is a view of a part or assembly
sModelName = swView.GetReferencedModelName
sModelName = LCase(sModelName)
sConfigName = swView.ReferencedConfiguration
FileConnu = False
If InStr(sModelName, "sldprt") > 0 Then
nDocType = swDocPART
ElseIf InStr(sModelName, "slasm") > 0 Then
nDocType = swDocASSEMBLY
Else
nDocType = swDocNONE
Exit Sub
End If
If nDocType = 1 Then
For I = 1 To nbConnu
If UCase(sModelName) & " - " & UCase(sConfigName) = TabConnu(I) Then
FileConnu = True
End If
Next
If Not FileConnu Then
nbConnu = nbConnu + 1
TabConnu(nbConnu) = UCase(sModelName) & " - " & UCase(sConfigName)
Call Export
End If
End If
Set swView = swView.GetNextView
Wend
Next vSheetName
End Sub
Sub Export()
Set swModel = swApp.ActivateDoc3(sModelName, True, swOpenDocOptions_Silent, lErrors)
Set swModel = swApp.ActiveDoc
boolstatus = swModel.ShowConfiguration2(sConfigName)
Set swConfig = swModel.GetActiveConfiguration
sPathName = swModel.GetPathName & ".step"
If Dir(sPathName, vbHidden) <> "" Then 'Test l'existence du fichier
suppr = MsgBox("Le fichier " & sPathName & " existe déjà, voulez vous le supprimer?", vbYesNo) 'Message utilisateur confirmation de suppression oui/non
If suppr = vbYes Then 'Réponse Oui
Kill (sPathName) 'Suppression du fichier existant
swModel.SaveAs2 sPathName, 0, True, False 'Enregistrement du fichier
op = MsgBox("Le fichier a été enregistré sous " & sPathName & vbNewLine)
Else 'Réponse NON
MsgBox ("Fichier conservé") 'Message utilisateur
End If
Else
swModel.SaveAs2 sPathName, 0, True, False 'Enregistrement du fichier
op = MsgBox("Le fichier a été enregistré sous " & sPathName) 'Message utilisateur
End If
swApp.CloseDoc (sModelName)
Set swModel = swApp.ActiveDoc
End Sub
Es handelt sich nur um sldprt-Dateien. Um sldasm zu verwenden, müssen Sie den Code ein wenig ändern. Es gibt einige Kommentare, die bei Bedarf bei der Wiederaufnahme helfen sollten.
1 „Gefällt mir“
Vielen Dank für Ihre Hilfe
Gern geschehen, das ist der Zweck des Forums
1 „Gefällt mir“