Hi everyone!
As part of an evolution of SW skin standards in the company, I realized that loading a new skin standard is not reliable: not all layers are present and even worse, the assignments are not always the right ones.
So I need to automate a lot of things:
-
Check the existence of each layer, otherwise create the missing ones (some have custom colors → need to set the color with the RGB code
-
Check the layers assigned for each element (dimensions, position label, center axis, cross-section, etc.) in the document properties
-
Force the default layer of the document to -According to the standard- (when opening the default layer is set to -None-, and I want to change it to -According to the standard-).
-
Reassign clip elements to the correct layers
I started with the last point for which I quickly found elements to help me on the forum, but I'm nevertheless stuck:
My code:
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
Problems /4:
-
Set swNote = swView.GetFirstNote allows me to select the notes attached to the views.
But how do you select the notes attached to the sheet in turn? -
Which API to select position labels?
-
Which API(s) to select the lines and cut labels?
Problems /3:
- I tried with swDraw.SetCurrentLayer("-According to the standard-") but -According to the standard- not really being a slap in the face... nothing happens. I figured maybe it was assigned to the first index in the layer list, but swDraw.SetCurrentLayer(0) doesn't work either.
Does anyone have an idea?
For the first 2 points I haven't started to look at them yet, but if anyone has elements or maybe even the code that allows you to make them I'm interested!
Thanks in advance!