Hallo Für einen Zeichnungsexport nur mit Ansichten suche ich nach einem Makro, das: 1 - blendet die Grundkarte aus (deaktivieren Sie " Grundkarte anzeigen " in der Blatteigenschaft) 2-blendet die Tabelle aus ‹ Nomenklatur1 › 3-Tabelle ausblenden ‹ Revisionstabelle1 › dann eine .ai-Registrierung und zeigen Sie schließlich die Hide-Elemente erneut an.
Eine Stückliste und eine Revisionstabelle pro Seite?
Das Ausblenden von Elementen ist im Makro nicht sehr kompliziert, aber Sie müssen die Anzahl der zu verbergenden Elemente kennen und wissen, ob eine Verarbeitung auf mehreren Blättern erfolgt oder nicht
Dim swSheet As SldWorks.Sheet
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swAnn As SldWorks.Annotation
Dim boolstatus As Boolean
Dim sPathName As String
Dim lErrors As Long
Dim lWarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox ("Pas de document ouvert")
Exit Sub
Else
Set swModelDocExt = swModel.Extension
If swModel.GetType <> 3 Then
MsgBox ("Il ne s'agît pas d'une mise en plan")
Else
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
swSheet.SheetFormatVisible = False ' Masque le fond de plan
Set swView = swDraw.GetFirstView
Do While Not Nothing Is swView
Set swAnn = swView.GetFirstAnnotation3
Do While Not Nothing Is swAnn
If swAnn.GetType = swTableAnnotation Then 'Verifie si c'est un objet de type table (BOM ou révision)
swAnn.Visible = swAnnotationHidden ' Cache les tables
End If
Set swAnn = swAnn.GetNext3
Loop
Set swView = swView.GetNextView
Loop
sPathName = swModel.GetPathName 'Recupere le nom complet du document actif
sPathName = Left(sPathName, Len(sPathName) - 6) 'Suppression de l'extension
sPathName = sPathName + "ai" 'Formatage du nom d'enregistrement
boolstatus = swModelDocExt.SaveAs3(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, Nothing, lErrors, lWarnings)
End If
swSheet.SheetFormatVisible = True 'Affiche le fond de plan
Set swView = swDraw.GetFirstView
Do While Not Nothing Is swView
Set swAnn = swView.GetFirstAnnotation3
Do While Not Nothing Is swAnn
If swAnn.GetType = swTableAnnotation Then 'Verifie si c'est un objet de type table (BOM ou révision)
swAnn.Visible = swAnnotationVisible ' Affiche les tables
End If
Set swAnn = swAnn.GetNext3
Loop
Set swView = swView.GetNextView
Loop
End If
End Sub
Es wurde nicht berücksichtigt, ob die AI-Datei existiert oder nicht (Hinzufügen möglich)
Hallo Ich muss schauen, aber aus dem Speicher lässt es nur der PDF-Export nativ in der API zu. Sie werden sicherlich " basteln" müssen, um die nicht zu exportierenden Blätter zu entfernen und dann die Datei zu schließen, ohne sie zu speichern.
Hallo Tatsächlich gibt es durch die Durchführung mehrerer Tests keine Möglichkeit, nur das Blatt 1 in .ai zu exportieren. Vorübergehend lösche ich sheet2, starte das Makro und wenn die generierte Datei anulate berührt (Strg + Z) . Ist es mit dem Makro spielbar.
Dim swSheet As SldWorks.Sheet
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As ModelDocExtension
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swAnn As SldWorks.Annotation
Dim boolstatus As Boolean
Dim sPathName As String
Dim lErrors As Long
Dim lWarnings As Long
Dim vSheetNameArr As Variant
Dim vSheetName As Variant
Dim lUndo As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox ("Pas de document ouvert")
Exit Sub
Else
Set swModelDocExt = swModel.Extension
If swModel.GetType <> 3 Then
MsgBox ("Il ne s'agît pas d'une mise en plan")
Else
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
swSheet.SheetFormatVisible = False ' Masque le fond de plan
Set swView = swDraw.GetFirstView
Do While Not Nothing Is swView
Set swAnn = swView.GetFirstAnnotation3
Do While Not Nothing Is swAnn
If swAnn.GetType = swTableAnnotation Then 'Verifie si c'est un objet de type table (BOM ou révision)
swAnn.Visible = swAnnotationHidden ' Cache les tables
End If
Set swAnn = swAnn.GetNext3
Loop
Set swView = swView.GetNextView
Loop
lUndo = swDraw.GetSheetCount - 1
vSheetNameArr = swDraw.GetSheetNames 'Récupère tous les noms de feuilles
For Each vSheetName In vSheetNameArr 'Boucle sur les noms de feuilles
If vSheetName <> "Feuille1" Then 'Sélection des feuilles autres que la feuille 1
swModel.SelectByName 0, vSheetName 'Sélection de la feuille à supprimer
boolstatus = swModel.DeleteSelection(False) 'Suppression de la feuille
End If
Next
sPathName = swModel.GetPathName 'Recupere le nom complet du document actif
sPathName = Left(sPathName, Len(sPathName) - 6) 'Suppression de l'extension
sPathName = sPathName + "ai" 'Formatage du nom d'enregistrement
boolstatus = swModelDocExt.SaveAs3(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, Nothing, lErrors, lWarnings)
End If
swModel.EditUndo2 (lUndo) 'Annule les suppressions de feuilles
swSheet.SheetFormatVisible = True 'Affiche le fond de plan
Set swView = swDraw.GetFirstView
Do While Not Nothing Is swView
Set swAnn = swView.GetFirstAnnotation3
Do While Not Nothing Is swAnn
If swAnn.GetType = swTableAnnotation Then 'Verifie si c'est un objet de type table (BOM ou révision)
swAnn.Visible = swAnnotationVisible ' Affiche les tables
End If
Set swAnn = swAnn.GetNext3
Loop
Set swView = swView.GetNextView
Loop
End If
End Sub
Hallo Perfekt, es funktioniert wunderbar!! Meine Fähigkeiten in VBA sind begrenzt, sogar sehr begrenzt. Also noch eine letzte Frage, wenn möglich auf dem angehängten Code, ich kann keine Lösung finden, um zu überprüfen ' ‹ ‹ Anzeige unter einem einzigen Artikel die Konfigurationen mit dem gleichen Namen › › in Gruppierung der Konfigurationen von Teilen des erstellten Namens. Haben Sie eine Lösung?
Vielen Dank für Ihre schnelle Antwort, aber es funktioniert nicht, es bleibt angekreuzt, um " die Konfigurationen der gleichen Münze separat anzuzeigen " › › während ich " die Konfigurationen mit dem gleichen Namen in einem einzigen Artikel anzeigen möchte". Wie lautet der Code? Vielen Dank