Cześć wszystkim!
W ramach ewolucji standardów skórek oprogramowania w firmie zdałem sobie sprawę, że wczytywanie nowego standardu skórki nie jest niezawodne: nie wszystkie warstwy są obecne, a co gorsza, przypisania nie zawsze są właściwe.
Muszę więc zautomatyzować wiele rzeczy:
-
Sprawdź istnienie każdej warstwy, w przeciwnym razie utwórz brakujące (niektóre mają niestandardowe kolory → trzeba ustawić kolor za pomocą kodu RGB
-
Sprawdź warstwy przypisane do każdego elementu (wymiary, etykieta pozycji, oś środkowa, przekrój itp.) we właściwościach dokumentu
-
Wymuś ustawienie domyślnej warstwy dokumentu na -Zgodnie ze standardem- (podczas otwierania warstwa domyślna jest ustawiona na -Brak-, a ja chcę ją zmienić na -Zgodnie ze standardem-).
-
Ponowne przypisywanie elementów klipu do odpowiednich warstw
Zacząłem od ostatniego punktu, do którego szybko znalazłem na forum elementy, które mi pomogły, ale mimo to utknąłem:
Mój kod:
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swLayerMgr As SldWorks.LayerMgr
Dim vLayerArr As Variant
Dim vLayer As Variant
Dim swLayer As SldWorks.Layer
Dim swDraw As SldWorks.DrawingDoc
Dim vSheets As Variant
Dim vSheet As Variant
Dim swView As SldWorks.View
Dim swAnn As SldWorks.Annotation
Dim swNote As SldWorks.Note
Dim swDispDim As SldWorks.DisplayDimension
Dim swGtol As SldWorks.Gtol
Dim swDatum As SldWorks.DatumTag
Dim swAnnSFSymbol As SldWorks.SFSymbol
Dim swAnnWeldSymbol As SldWorks.WeldSymbol
Dim swCtrMark As SldWorks.CenterMark
Dim swCenterLine As SldWorks.Centerline
Dim swTables As Variant
Dim swTable As Variant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Ouvrez et/ou activez une mise en plan."
Exit Sub
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
MsgBox "Ouvrez et/ou activez une mise en plan."
Exit Sub
End If
Set swDraw = swModel
vSheets = swDraw.GetSheetNames
For Each vSheet In vSheets
swDraw.ActivateSheet vSheet
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
While Not swView Is Nothing
Set swCtrMark = swView.GetFirstCenterMark
While Not swCtrMark Is Nothing
Set swAnn = swCtrMark.GetAnnotation
swAnn.Layer = "Axes"
Set swCtrMark = swCtrMark.GetNext
Wend
Set swCenterLine = swView.GetFirstCenterLine
While Not swCenterLine Is Nothing
Set swAnn = swCenterLine.GetAnnotation
swAnn.Layer = "Axes"
Set swCenterLine = swCenterLine.GetNext
Wend
Set swDatum = swView.GetFirstDatumTag
While Not swDatum Is Nothing
Set swAnn = swDatum.GetAnnotation
swAnn.Layer = "Références"
Set swDatum = swDatum.GetNext
Wend
Set swGtol = swView.GetFirstGTOL
While Not swGtol Is Nothing
Set swAnn = swGtol.GetAnnotation
swAnn.Layer = "Cotes"
Set swGtol = swGtol.GetNextGTOL
Wend
Set swAnnSFSymbol = swView.GetFirstSFSymbol
While Not swAnnSFSymbol Is Nothing
Set swAnn = swAnnSFSymbol.GetAnnotation
swAnn.Layer = "État de surface"
Set swAnnSFSymbol = swAnnSFSymbol.GetNext
Wend
Set swAnnWeldSymbol = swView.GetFirstWeldSymbol
While Not swAnnWeldSymbol Is Nothing
Set swAnn = swAnnWeldSymbol.GetAnnotation
swAnn.Layer = "Soudures"
Set swAnnWeldSymbol = swAnnWeldSymbol.GetNext
Wend
Set swDispDim = swView.GetFirstDisplayDimension5
While Not swDispDim Is Nothing
Set swAnn = swDispDim.GetAnnotation
swAnn.Layer = "Cotes"
Set swDispDim = swDispDim.GetNext5
Wend
Set swView = swView.GetNextView
Wend
Next
swModel.ClearSelection2 True
Problemy /4:
-
Ustawienie swNote = swView.GetFirstNote pozwala mi wybrać notatki dołączone do widoków.
Ale jak po kolei wybrać notatki dołączone do arkusza? -
Który interfejs API wybrać etykiety pozycji?
-
Które interfejsy API wybrać linie i etykiety cięcia?
Problemy /3:
- Próbowałem z swDraw.SetCurrentLayer("-Zgodnie ze standardem-"), ale -Zgodnie ze standardem- nie jest to naprawdę policzek... Nic się nie dzieje. Doszedłem do wniosku, że może jest przypisany do pierwszego indeksu na liście warstw, ale swDraw.SetCurrentLayer(0) też nie działa.
Czy ktoś ma pomysł?
Co do pierwszych 2 punktów jeszcze nie zacząłem się do nich przyglądać, ale jeśli ktoś ma elementy, a może nawet kod, który pozwala na ich wykonanie to jestem zainteresowany!
Z góry dzięki!