Hallo
Voor een tekening-export alleen met weergaven, ben ik op zoek naar een macro die:
1 - verbergt de basiskaart (verwijder het vinkje bij ' Toon basiskaart ' in de eigenschap van het werkblad)
2-verbergt de tafel ‹ Nomenclatuur1 ›
3-Verberg tabel ‹ Revisietabel1 ›
Dan een .ai registratie
en ten slotte de verbergelementen opnieuw weergeven.
Bij voorbaat dank voor jullie hulp.
Thierry
Hallo
Een aantal vragen:
Het verbergen van elementen is niet erg ingewikkeld in macro's, maar je moet weten hoeveel elementen je wilt verbergen en of een verwerking op meerdere vellen is of niet
Hallo
ja, een enkel blad ‹ Blad1 ›
Eén stuklijst ‹ Schema1 ›
en een enkele revisietabel ‹ Revisietabel1 ›
Bedankt
Hallo
Onderstaande code om te testen:
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
Heeft niet behandeld of het ai-bestand bestaat of niet (mogelijk om toe te voegen)
Bedankt, dat is perfect!!
Hallo
Ik heb een onderwerp overgeslagen.
Als er meerdere vellen zijn, wil ik alleen het 1e vel in Ai opslaan, momenteel slaat de macro alle vellen op
Bedankt voor je hulp.
Thierry
Hallo
Ik moet kijken, maar vanuit het geheugen alleen de PDF-export staat het native toe in de API.
Je zult zeker moeten " sleutelen" om de vellen te verwijderen die niet moeten worden geëxporteerd en vervolgens het bestand te sluiten zonder op te slaan.
Hallo
Door verschillende tests uit te voeren, is het namelijk onmogelijk om alleen het blad 1 in .ai te exporteren.
Tijdelijk, verwijder ik sheet2, start de macro en wanneer het gegenereerde bestand aanraakt, anuleren (ctrl + Z) .
Is het speelbaar met de macro.
Bedankt
Thierry
Hallo
Ja goed te doen, ik kijk ernaar als ik wat tijd heb
Hallo
Hier is de gewijzigde code:
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
Perfect, het werkt wonderwel!!
Mijn vaardigheden in VBA zijn beperkt, zelfs zeer beperkt.
Dus nog een laatste vraag, indien mogelijk op de bijgevoegde code, kan ik de oplossing niet vinden om ' ‹ ‹ weergeven onder een enkel artikel de configuraties met dezelfde naam › › aan te vinken bij het groeperen van de configuraties van delen van de gemaakte naam.
Heb je een oplossing?
Bij voorbaat nogmaals hartelijk dank
nomenclatue.docx (17.5 KB)
Hallo
Moet toevoegen: swBOMFeat.DisplayAsOneItem = True
Hallo
Bedankt voor je snelle antwoord, maar het werkt niet, het blijft aangevinkt om ' 'de configuraties van dezelfde munt afzonderlijk weer te geven' › › terwijl ik ' 'de configuraties met dezelfde naam onder een enkel artikel wil weergeven''.
Wat is de code??
Bedankt
Sorry, ik heb de verkeerde parameter: swBOMFeat.PartConfigurationGrouping = swDisplay_AllConfigurationOfSamePart_AsOneItem