6 Replies Latest reply on Jun 8, 2015 3:21 AM by Mario Zahren

    How to change the layer of annotations?

    Mario Zahren

      Hello all,

       

      I´m trying to become a vba-programmer but it doesn´t work ...

      I cannot figure out how to change the layer of annotations like:

       

                centermarks

                centerlines

                notes

                ballons

                symbols

                etc.

                and all sketched lines "for construction" (dot-dash lines).

       

      It is a must to do it with a macro because I have to reorganize wrong allocated annotations while saving the document automatically.

       

      Can anybody help?

       

      Thanks

        • Re: How to change the layer of annotations?
          Adam Hoffman

          If you can be a bit more descriptive on what exactly has to be changed to a different layer. Is it ALL annotations? Just certain types of annotations? What layer name are you wanting to use? We could piece something together for you to get you started if we have a little more detailed information. As far as learning the API, I would suggest looking at Keith Rice's website:

           

          SolidWorks API Video Tutorials

           

          He has a lot of good stuff on there and is very knowledgeable about the API.

            • Re: How to change the layer of annotations?
              Mario Zahren

              Hi Adam an Deepak,

               

               

              here's the code I created so far. The last 4 subs are changing the Layer to "Hauptrahmen".
              What's still missing is a feature that changes the layer for lines "for construction" (dot-dash lines). See the picture below. I tried recording a macro to tweak them but w/o success...

               

               

               

              Private Sub cbLNG_Change()

              Option Explicit

               

              Dim sLNG            As String

              Dim Sprache         As String

              Dim Path            As String

              Dim Index           As String

               

              Private Const BIF_RETURNONLYFSDIRS As Long = &H1

              Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

              Private Const BIF_RETURNFSANCESTORS As Long = &H8

              Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

              Private Const BIF_BROWSEFORPRINTER As Long = &H2000

              Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

              Private Const MAX_PATH As Long = 260

               

              Private Enum SWP_Flags

                  SWP_NOSIZE = &H1

                  SWP_NOMOVE = &H2

                  SWP_NOACTIVATE = &H10

                  SWP_SHOWWINDOW = &H40

              End Enum

               

              Private Const HWND_TOPMOST = -1

              Private Const HWND_NOTOPMOST = -2

               

              Select Case cbLNG

              Case "cs": Sprache = "Tschechisch"

              Case "en": Sprache = "Englisch"

              Case "es": Sprache = "Spanisch"

              Case "fr": Sprache = "Französisch"

              Case "hu": Sprache = "Ungarisch"

              Case "it": Sprache = "Italienisch"

              Case "KU": Sprache = "KUNDENZEICHNUNG"

              Case "mx": Sprache = "Mexikanisch"

              Case "pb": Sprache = "Brasilianisch"

              Case "pl": Sprache = "Polnisch"

              Case "ru": Sprache = "Russisch"

              Case "sv": Sprache = "Schwedisch"

              Case "tr": Sprache = "Türkisch"

              Case "zs": Sprache = "Chinesisch Simple"

              Case "zt": Sprache = "Chinesisch Traditional"

              Case "": Sprache = "Keine Sprache"

              Case Else: Sprache = "Gibbet nisch!"

              End Select

              frmLNG.Label1.Caption = Sprache

               

              If Index <> "" Then

                  Call TextBox1_Change

              End If

               

              End Sub

               

              Private Sub cmdOK_Click()

                      sLNG = cbLNG.Text

                      Me.Hide

                      Call main

                      Call layer

                      Call bomSetLayer

                      Call dimensionSetLayer

                      Call centerlineSetLayer

                      Call centermarkSetLayer

                      Call browse

              End Sub

               

              Private Sub TextBox1_Change()

                  Index = frmLNG.TextBox1

              End Sub

               

              Private Sub UserForm_Activate()

               

                  'Sprachen hinzufügen

                  cbLNG.AddItem ""  'listindex = 0 !!!!

                  cbLNG.AddItem "cs"

                  cbLNG.AddItem "en"

                  cbLNG.AddItem "es"

                  cbLNG.AddItem "fr"

                  cbLNG.AddItem "hu"

                  cbLNG.AddItem "it"

                  cbLNG.AddItem "KU"

                  cbLNG.AddItem "mx"

                  cbLNG.AddItem "pb"

                  cbLNG.AddItem "pl"

                  cbLNG.AddItem "ru"

                  cbLNG.AddItem "sv"

                  cbLNG.AddItem "tr"

                  cbLNG.AddItem "zs"

                  cbLNG.AddItem "zt"

                  cbLNG.ListIndex = 0 'auf NIX listindex = 0 stellen!!!

              End Sub

               

              Sub main()

               

                  Dim swApp           As SldWorks.SldWorks

                  Dim Retval          As Boolean

                  Dim InfoCount       As Long

                  Dim InfoNames       As Variant

                  Dim K               As Integer

                  Dim Part            As SldWorks.ModelDoc2

                  Dim View            As SldWorks.View

                  Dim ModType         As Long

               

              If (sLNG = "") Then

                  If MsgBox("Bitte Sprachcode angeben!", vbOKCancel, "Keine Sprache?") = vbOK Then

                      Call NDFExport

                  Else

                      End

                  End If

              End If

               

                  Set swApp = GetObject(, "SldWorks.Application")

                  Set Part = swApp.ActiveDoc

                  ModType = swApp.ActiveDoc.GetType

               

              If Not Part Is Nothing Then

                  InfoCount = Part.GetCustomInfoCount2("")            ' wieviele Benutzerdef. Eigenschaften im akt. Teil?

                  InfoNames = Part.GetCustomInfoNames2("")            ' Alle Namen der Benutzerdef. Eigenschaften in ein Variant einlesen

                    

                      For K = 0 To InfoCount - 1                      ' Schleife durch alle Benutzerdef. Eigenschaften

                            

                              If _

                              Left(InfoNames(K), 2) = "M_" Or InfoNames(K) = "MErsteller" Or InfoNames(K) = "MErstellerD" Or InfoNames(K) = "Ersteller" Or InfoNames(K) = "Index4" Or InfoNames(K) = "Index5" _

                              Or InfoNames(K) = "Erstelldatum" Or InfoNames(K) = "Pruefer" Or InfoNames(K) = "PrueferD" Or InfoNames(K) = "Pruefdatum" Or InfoNames(K) = "Index6" Or InfoNames(K) = "Index7" _

                              Or InfoNames(K) = "SL_GEPRÜFTAM" Or InfoNames(K) = "SL_GEPRÜFTVON" Or InfoNames(K) = "Author" Or InfoNames(K) = "Benennung" Or InfoNames(K) = "Index3" Or InfoNames(K) = "Index2" _

                              Or InfoNames(K) = "Nummer" Or InfoNames(K) = "SL_NUMMER" Or InfoNames(K) = "Ursprung" Or InfoNames(K) = "Bearbeiter1" Or InfoNames(K) = "Bearbeiter2" Or InfoNames(K) = "Bearbeiter3" _

                              Or InfoNames(K) = "Datum1" Or InfoNames(K) = "Einheit" Or InfoNames(K) = "HS_Signale" Or InfoNames(K) = "HS_SignaleLang" Or InfoNames(K) = "Bearbeiter4" Or InfoNames(K) = "Bearbeiter5" _

                              Or InfoNames(K) = "MPruefer" Or InfoNames(K) = "MPrüfer" Or InfoNames(K) = "MPrueferD" Or InfoNames(K) = "MPrüferD" Or InfoNames(K) = "Bearbeiter6" Or InfoNames(K) = "Bearbeiter7" _

                              Or InfoNames(K) = "IsKaufteil" Or InfoNames(K) = "IsVerschleissteil" Or InfoNames(K) = "IsNormteil" Or InfoNames(K) = "Number" Or InfoNames(K) = "Bearbeiter8" Or InfoNames(K) = "Aenderung2" _

                              Or InfoNames(K) = "Description" Or InfoNames(K) = "Project" Or InfoNames(K) = "Ersetztd" Or InfoNames(K) = "Klasse" Or InfoNames(K) = "Datum2" Or InfoNames(K) = "Datum3" Or InfoNames(K) = "Datum4" _

                              Or InfoNames(K) = "Typ" Or InfoNames(K) = "Bemerkung" Or InfoNames(K) = "DEF_STKID" Or InfoNames(K) = "ErstellerD" Or InfoNames(K) = "Datum5" Or InfoNames(K) = "Datum6" Or InfoNames(K) = "Datum7" _

                              Or InfoNames(K) = "Art" Or InfoNames(K) = "Artikelstamm" Or InfoNames(K) = "Fertigungsdatum" Or InfoNames(K) = "Firmenname" Or InfoNames(K) = "Datum8" Or InfoNames(K) = "Aenderung1" _

                              Or InfoNames(K) = "Kunde" Or InfoNames(K) = "Masch-Typ" Or InfoNames(K) = "MAX-Ordn-Nr" Or InfoNames(K) = "Norm" Or InfoNames(K) = "Aenderung3" Or InfoNames(K) = "Aenderung4" _

                              Or InfoNames(K) = "NormD" Or InfoNames(K) = "Revision_Beschr" Or InfoNames(K) = "Revision_Ersteller" Or InfoNames(K) = "RevisionD" Or InfoNames(K) = "Aenderung6" Or InfoNames(K) = "Aenderung7" _

                              Or InfoNames(K) = "Technologie" Or InfoNames(K) = "TechnologieD" Or InfoNames(K) = "Toleranzangabe1" Or InfoNames(K) = "Toleranzangabe2" Or InfoNames(K) = "Aenderung8" Or InfoNames(K) = "ZNR_7_6" _

                              Or InfoNames(K) = "HME_DIN" Or InfoNames(K) = "HME_Projekt" Or InfoNames(K) = "HME_Auftrag" Or InfoNames(K) = "Aenderung5" Or InfoNames(K) = "Vorgänger" Or InfoNames(K) = "Projekt" _

                              Or InfoNames(K) = "Sprachcode" Or InfoNames(K) = "Gewicht" Or InfoNames(K) = "SL_ERSTELLDATUM" Or InfoNames(K) = "HS_Bez2" Or InfoNames(K) = "SL_MATERIAL" Or InfoNames(K) = "SL_BENENNUNG" _

                              Or InfoNames(K) = "Dateiname" Or InfoNames(K) = "Hersteller" Or InfoNames(K) = "SL_ERSTELLER" Or InfoNames(K) = "Index1" _

                              Then

                                  Retval = Part.DeleteCustomInfo2("", InfoNames(K))    ' Löschen aller Eigenschaften

                              End If

                      Next K

                      

                        Retval = Part.AddCustomInfo3("", "Sprachcode", swCustomInfoText, sLNG)

                        Retval = Part.AddCustomInfo3("", "Dateiname", swCustomInfoText, "$PRP:" & Chr(34) & "SW-Dateiname(Filename)" & Chr(34))

              End If

               

                  'Reduziert zu vollständig

                  If ModType = 3 Then                         'Zeichnung (Draw)

                      Set Part = swApp.ActiveDoc

                      Set View = Part.GetFirstView

                      Set View = View.GetNextView

                  End If

                

                  With Part

                    

                      'Force rebuild

                      .ForceRebuild3 True

                    

                      'Wiederaufbau Grafikbereich

                      .GraphicsRedraw

                    

                      'Fit to Screen

                      .ViewZoomtofit2

                

                  End With

               

                  Set Part = Nothing

                  Set swApp = Nothing

                  Set View = Nothing

               

              End Sub

               

              Function BrowseFolder(Optional Caption As String, _

                  Optional InitialFolder As String) As String

               

                  Dim SH As Shell32.Shell

                  Dim F As Shell32.Folder

               

                  Set SH = New Shell32.Shell

                  Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, "D:\hegenscheidt\")

                  If Not F Is Nothing Then

                      BrowseFolder = F.Items.Item.Path

                  End If

               

              End Function

               

              Sub browse()

               

                  Dim swApp           As SldWorks.SldWorks

                  Dim swModel         As SldWorks.ModelDoc2

                  Dim swDraw          As SldWorks.DrawingDoc

                  Dim swView          As SldWorks.View

                  Dim bRet            As Boolean

                  Dim PartNumber      As String

                  Dim Revision        As String

                  Dim NewRevision     As String

                  Dim ConfName        As String

                  Dim MyFileName      As String

                  Dim nErrors         As Long

                  Dim nWarnings       As Long

               

                  Set swApp = Application.SldWorks

                  Set swModel = swApp.ActiveDoc

                  Set swDraw = swModel

                  Set swView = swDraw.GetFirstView

                      

                  Path = BrowseFolder()

                  If Path = "" Then

                

                      If MsgBox("Bitte Ausgabepfad bestimmen!", vbOKCancel, "Nicht speichern?") = vbOK Then

                          Call browse

                      Else

                          End

                      End If

                

                  End If

                

                  Path = Path & "\"

               

                  PartNumber = swModel.GetCustomInfoValue("", "HME_Artikelnummer")

                  Revision = swModel.GetCustomInfoValue("", "Revision")

                  NewRevision = Mid(Revision, Len(Revision) - 4, 5)

                  NewRevision = Replace(NewRevision, ".", "")

               

                  Set swView = swView.GetNextView

               

                  ConfName = swView.ReferencedConfiguration

                  MyFileName = PartNumber & "-" & ConfName & "-" & NewRevision & Index & "-" & sLNG & ".SLDDRW"

               

                  'Speichern

                  swModel.Extension.SaveAs Path & MyFileName, swSaveAsCurrentVersion, swSaveAsOptions_Copy, Nothing, nErrors, nWarnings

                

              End Sub

               

              Sub layer()

               

                  Dim swApp           As Object

                  Dim pDrawing        As Object

                  Dim pLayerMgr       As Object

                  Dim swLayer         As Object

                  Dim res             As Boolean

                  Dim pLayerArr       As Variant

                  Dim pLayer          As Variant

               

              Set swApp = Application.SldWorks

              Set pDrawing = swApp.ActiveDoc

              Set pLayerMgr = pDrawing.GetLayerManager

               

              'wenn KU = kunde dann NIX!

              If (sLNG = "KU") Then

              Exit Sub

              End If

               

              'Debug.Print sLNG

               

              pLayerArr = pLayerMgr.GetLayerList

               

              For Each pLayer In pLayerArr

                  Set swLayer = pLayerMgr.GetLayer(pLayer)

                  swLayer.Visible = False

              Next

               

              Set swLayer = pLayerMgr.GetLayer(sLNG)

              swLayer.Visible = True

              Set swLayer = pLayerMgr.GetLayer("Hauptrahmen")

              swLayer.Visible = True

              Set swLayer = pLayerMgr.GetLayer("Variabler Text")

              swLayer.Visible = True

              res = pLayerMgr.SetCurrentLayer(sLNG)

               

              If (res = False) Then

              swApp.SendMsgToUser "Konnte Layer nicht aktivieren"

              Exit Sub

              End If

               

              End Sub

               

              Sub bomSetLayer()

               

                  Dim swApp           As SldWorks.SldWorks

                  Dim swModel         As SldWorks.ModelDoc2

                  Dim swDraw          As SldWorks.DrawingDoc

                  Dim swView          As SldWorks.View

                  Dim swTableAnn      As SldWorks.TableAnnotation

                  Dim swAnn           As SldWorks.Annotation

               

                  Set swApp = Application.SldWorks

                  Set swModel = swApp.ActiveDoc

                  Set swDraw = swModel

                  Set swView = swDraw.GetFirstView

                  Set swTableAnn = swView.GetFirstTableAnnotation

               

                  While Not swTableAnn Is Nothing

               

                      If swTableAnn.Type = swTableAnnotation_BillOfMaterials Then

                          Set swAnn = swTableAnn.GetAnnotation

                          swAnn.Select3 False, Nothing

                          swAnn.layer = "Hauptrahmen"

               

                      End If

                      Set swTableAnn = swTableAnn.GetNext

                  Wend

                

              End Sub

               

              Sub dimensionSetLayer()

               

                  Dim swApp           As SldWorks.SldWorks

                  Dim swModel         As SldWorks.ModelDoc2

                  Dim swDraw          As SldWorks.DrawingDoc

                  Dim swView          As SldWorks.View

                  Dim swAnn           As SldWorks.Annotation

                  Dim swDispDim       As SldWorks.DisplayDimension

                  Dim NumShts         As Long

                  Dim i               As Long

                

                

                  Set swApp = CreateObject("SldWorks.Application")

                  Set swModel = swApp.ActiveDoc

                  Set swDraw = swModel

                

                  NumShts = swDraw.GetSheetCount

                  For i = 1 To NumShts

                      swDraw.SheetPrevious

                  Next i

                

                  For i = 1 To NumShts

                      Set swView = swDraw.GetFirstView

                      While Not swView Is Nothing

                          Set swDispDim = swView.GetFirstDisplayDimension5

                          While Not swDispDim Is Nothing

                              Set swAnn = swDispDim.GetAnnotation

                            

                              swAnn.layer = "Hauptrahmen"

                            

                              Set swDispDim = swDispDim.GetNext5

                          Wend

                        

                          Set swView = swView.GetNextView

                      Wend

                    

                      swDraw.SheetNext

                  Next i

              End Sub

              Sub centerlineSetLayer()

                  Dim swApp                   As SldWorks.SldWorks

                  Dim swModel                 As SldWorks.ModelDoc2

                  Dim swDraw                  As SldWorks.DrawingDoc

                  Dim swView                  As SldWorks.View

                  Dim swAnn                   As SldWorks.Annotation

                  Dim swDispCenter            As SldWorks.centerline

                  Dim NumShts                 As Long

                  Dim i                       As Long

                

                  Set swApp = CreateObject("SldWorks.Application")

                  Set swModel = swApp.ActiveDoc

                  Set swDraw = swModel

                

                  NumShts = swDraw.GetSheetCount

                  For i = 1 To NumShts

                      swDraw.SheetPrevious

                  Next i

                

                  For i = 1 To NumShts

                      Set swView = swDraw.GetFirstView

                      While Not swView Is Nothing

                          Set swDispCenter = swView.GetFirstCenterLine

                          While Not swDispCenter Is Nothing

                              Set swAnn = swDispCenter.GetAnnotation

                            

                              swAnn.layer = "Hauptrahmen"

                              Debug.Print "Layer ist " & swAnn.layer

                            

                              Set swDispCenter = swDispCenter.GetNext

                          Wend

                        

                          Set swView = swView.GetNextView

                      Wend

                    

                      swDraw.SheetNext

                  Next i

              End Sub

               

              Sub centermarkSetLayer()

                  Dim swApp                   As SldWorks.SldWorks

                  Dim swModel                 As SldWorks.ModelDoc2

                  Dim swDraw                  As SldWorks.DrawingDoc

                  Dim swView                  As SldWorks.View

                  Dim swAnn                   As SldWorks.Annotation

                  Dim swDispCenter            As SldWorks.centermark

                  Dim NumShts                 As Long

                  Dim i                       As Long

                 

                  Set swApp = CreateObject("SldWorks.Application")

                  Set swModel = swApp.ActiveDoc

                  Set swDraw = swModel

                

                  NumShts = swDraw.GetSheetCount

                  For i = 1 To NumShts

                      swDraw.SheetPrevious

                  Next i

                

                  For i = 1 To NumShts

                      Set swView = swDraw.GetFirstView

                      While Not swView Is Nothing

                          Set swDispCenter = swView.GetFirstCenterMark

                          While Not swDispCenter Is Nothing

                              Set swAnn = swDispCenter.GetAnnotation

                            

                              swAnn.layer = "Hauptrahmen"

                              Debug.Print "Layer ist " & swAnn.layer

                            

                              Set swDispCenter = swDispCenter.GetNext

                          Wend

                        

                          Set swView = swView.GetNextView

                      Wend

                    

                      swDraw.SheetNext

                  Next i

              End Sub

                • Re: How to change the layer of annotations?
                  Adam Hoffman

                  This code works for me. You might try checking the annotation type on the center mark that you are trying to modify and make sure it is actually classified as a center mark symbol.

                   

                  Dim swApp As SldWorks.SldWorks

                  Dim swModel  As SldWorks.ModelDoc2

                  Dim swDraw As SldWorks.DrawingDoc

                  Dim swView As SldWorks.View

                  Dim swAnno As SldWorks.Annotation

                  Const MyAnnoLayer As String = "Hauptrahmen"

                   

                  Sub main()

                  Set swApp = _
                  Application.SldWorks

                   

                  If swApp.GetDocumentCount() = 0 Then Exit Sub

                   

                  Set swModel = swApp.ActiveDoc
                     
                  If Not swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then Exit Sub

                   

                  Set swDraw = swModel

                   

                  CheckForAnnoLayer swModel

                   

                  Set swView = swDraw.GetFirstView

                   

                  Do While Not swView Is Nothing

                   

                       Dim swDispCenter As SldWorks.CenterMark
                    
                       Set swDispCenter = swView.GetFirstCenterMark
                    
                       Do While Not swDispCenter Is Nothing
                    
                             Set swAnno = swDispCenter.GetAnnotation
                       
                             If Not swAnno Is Nothing Then

                   

                                Debug.Print ("The Current Annotation Type Is: " + CStr(swAnno.GetType))
                          
                                If swAnno.GetType() = swAnnotationType_e.swCenterMarkSym Then
                          
                                   swAnno.Layer = MyAnnoLayer
                             
                                End If
                          
                            End If
                       
                            Set swDispCenter = swDispCenter.GetNext
                    
                         Loop
                    
                       Set swView = swView.GetNextView

                   

                  Loop

                   

                  swModel.ForceRebuild3 (False)

                   

                  End Sub

                   

                  Sub CheckForAnnoLayer(ByVal swModel As SldWorks.ModelDoc2)

                   

                  Dim swLayerMgr       As SldWorks.LayerMgr
                  Dim vLayerArr        As Variant
                  Dim vLayer           As Variant
                  Dim swLayer          As SldWorks.Layer
                  Dim bFound           As Boolean
                  Dim iRet             As Long

                   

                  If swModel Is Nothing Then Exit Sub

                   

                  Set swLayerMgr = swModel.GetLayerManager

                   

                  vLayerArr = swLayerMgr.GetLayerList

                   

                  bFound = False

                   

                  For Each vLayer In vLayerArr

                   

                      Set swLayer = swLayerMgr.GetLayer(vLayer)
                     
                      If swLayer.Name = MyAnnoLayer Then bFound = True
                     
                  Next

                   

                  If bFound = False Then

                   

                     iRet = swLayerMgr.AddLayer(MyAnnoLayer, "", 0, swLineStyles_e.swLineCONTINUOUS, swLineWeights_e.swLW_NORMAL)
                    
                  End If

                   

                  End Sub

                  • Re: How to change the layer of annotations?
                    Adam Hoffman

                    You can try using this to figure out exactly what type of annotation it is. Just select the center mark and run this macro and it should tell you what type of annotation you have selected.

                • Re: How to change the layer of annotations?
                  Deepak Gupta

                  Have you tried recording macros for various annotations types and tweak them?