Witam
Do eksportu rysunku tylko z widokami szukam makra, które:
1 - ukrywa mapę bazową (odznacz opcję ' Pokaż mapę bazową ' we właściwości arkusza)
2-ukrywa tabelę ‹ Nomenklatura1 ›
3-Ukryj tabelę ‹ Tabela zmian1 ›
Następnie rejestracja w domenie .ai
i na koniec ponownie wyświetl elementy ukrywania.
Z góry wszystkim dziękuję za pomoc.
Thierry
Witam
Kilka pytań:
Ukrywanie elementów w makrach nie jest bardzo skomplikowane, ale musisz znać liczbę elementów do ukrycia i czy przetwarzanie jest na kilku arkuszach, czy nie
Witam
tak, pojedynczy arkusz ‹ Arkusz1 ›
Jedna lista materiałów ‹ Harmonogram1 ›
i pojedynczą tabelę zmian ‹ Tabela zmian1 ›
Dziękuję
Witam
Poniższy kod do przetestowania:
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
Nie obsłużono, czy plik ai istnieje, czy nie (możliwe do dodania)
Dziękuję, to idealnie!!
Witam
Pominąłem temat.
Jeśli kilka arkuszy, chcę zapisać tylko 1 arkusz w Ai, obecnie makro zapisuje wszystkie arkusze
Dziękuję za pomoc.
Thierry
Witam
Muszę poszukać, ale z pamięci tylko eksport PDF pozwala na to natywnie w API.
Z pewnością będziesz musiał " majstrować" , aby usunąć arkusze, które nie mają być eksportowane, a następnie zamknąć plik bez zapisywania.
Witam
W rzeczywistości, przeprowadzając kilka testów, nie ma możliwości wyeksportowania tylko arkusza 1 w .ai.
Tymczasowo usuwam arkusz2, uruchamiam makro i po wygenerowaniu pliku dotykam anulate (ctrl + Z) .
Czy można go odtwarzać za pomocą makra.
Dziękuję
Thierry
Witam
Tak, wykonalne, patrzę na to, gdy mam trochę czasu
Witam
Oto zmodyfikowany kod:
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
Witam
Idealnie, działa cudownie!!
Moje umiejętności w VBA są ograniczone, nawet bardzo ograniczone.
Więc ostatnie pytanie, jeśli to możliwe w załączonym kodzie, nie mogę znaleźć rozwiązania, aby sprawdzić ' ‹ ‹ wyświetlić pod jednym artykułem konfiguracje o tej samej nazwie › › w Grupowanie konfiguracji części utworzonej nazwy.
Czy masz rozwiązanie?
Z góry jeszcze raz wielkie podziękowania
nomenclatue.docx (17,5 KB)
Witam
Należy dodać: swBOMFeat.DisplayAsOneItem = True
Witam
Dziękuję za szybką odpowiedź, ale to nie działa, pozostaje zaznaczone na ' 'wyświetlanie osobno konfiguracji tej samej monety ' › › podczas gdy ja chcę ' 'wyświetlać pod jednym artykułem konfiguracje o tej samej nazwie''.
jaki jest kod?
Dziękuję
Przepraszam, dostałem zły parametr: swBOMFeat.PartConfigurationGrouping = swDisplay_AllConfigurationOfSamePart_AsOneItem