3 Replies Latest reply on Jun 1, 2015 6:00 PM by Mike Helsinger

    Editing Drawing Title Block Text Macro

    Kieran Hickman

      I have several hundred drawings all exactly the same text in my title block. I would like to change the specific text in my drawing to something different.
      I have tried recording a macro but i am not very proficient with looping and editing VBA. Could any body help me?


      Here is what I have recorded so far which should indicate which text I want to edit.

      Dim swApp As Object


      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long


      Sub main()


      Set swApp = _



      Set Part = swApp.ActiveDoc

      Dim myModelView As Object

      Set myModelView = Part.ActiveView

      myModelView.FrameState = swWindowState_e.swWindowMaximized

      boolstatus = Part.Extension.SelectByID2("Model", "SHEET", 0.21782274744649, 0.115453914514345, 0, False, 0, Nothing, 0)



      Part.ClearSelection2 True

      boolstatus = Part.Extension.SelectByID2("DetailItem105@Sheet Format1", "NOTE", 0.227379598659814, 0.019531444928762, 0, False, 0, Nothing, 0)

      Part.ClearSelection2 True

      End Sub

        • Re: Editing Drawing Title Block Text Macro
          Paul Marsman


            I took a much larger macro I have for when I did a major set of changes to our templates and tried to remove anything not required for what you are looking to do.  This will batch through any drawing in a directory and all sub folders that you specify in the BatchDrwFiles call.  This should at least get you started.





          Option Explicit
          Option Compare Text
          Const NumStrings As Long = 3
          Dim OldString(NumStrings) As String
          Dim NewString(NumStrings) As String

          Dim swApp               As SldWorks.SldWorks
          Dim swSktManager        As SldWorks.SketchManager
          Dim swModel             As SldWorks.ModelDoc2
          Dim swModelDocExt       As SldWorks.ModelDocExtension
          Dim swMathUtility       As SldWorks.MathUtility
          Dim swMathPoint         As SldWorks.MathPoint
          Dim PointCoords(2)      As Double
          Dim swSktBlkDef         As SldWorks.SketchBlockDefinition
          Dim vSheetProps         As Variant
          Dim swSheet             As SldWorks.Sheet
          Dim scl                 As Double
          Dim angle               As Double
          Dim swLayerMgr          As SldWorks.LayerMgr
          Dim CheckStr            As String
          Dim ChcekInt            As Integer
          Dim CheckInt            As Integer

          Dim sPath               As String
          Dim swDraw              As SldWorks.DrawingDoc
          Dim swView              As SldWorks.View
          Dim swNote              As SldWorks.Note

          Dim sNoteText           As String
          Dim nTextCount          As Long
          Dim bUpDwg              As Boolean

          Dim swFilename          As String
          Dim nErrors             As Long
          Dim nWarnings           As Long
          Dim fso                 As New Scripting.FileSystemObject


          Dim Response            As String
          Dim DocName             As String
          Dim bret                As Boolean
          Dim vBlockDef                   As Variant
          Dim vBlockInst                  As Variant
          Dim BlkName As String
          Dim AlreadyExists   As Boolean
          Dim CopyExists As Boolean
          Dim oldCopyright As Boolean
          Dim swBlockDef                  As SldWorks.SketchBlockDefinition
          Dim swBlockInst                 As SldWorks.SketchBlockInstance
          Dim vSheetName As Variant
          Dim i As Integer
          Dim j As Integer
          Dim k As Integer
          Dim oleobjoptions As Long

          Dim swDocTypeLong As Long
          Dim vOleObjs As Variant
          Dim swOleObj As SldWorks.SwOLEObject
          Dim m As Integer

          Sub main()
              Set swApp = Application.SldWorks
              bUpDwg = False
              BatchDrwFiles "G:\", ".SLDDRW", True

              MsgBox "DONE"
          End Sub

          Sub BatchDrwFiles(folder As String, ext As String, silent As Boolean)

              If Right(folder, 1) <> "\" Then folder = folder & "\"
              ext = UCase$(ext)
              swDocTypeLong = Switch(ext = ".SLDPRT", swDocPART, ext = ".SLDDRW", swDocDRAWING, ext = ".SLDASM", swDocASSEMBLY, True, -1)
              'If not a SW file, return
              If swDocTypeLong = -1 Then Exit Sub
              ChDir (folder)
              Response = Dir(folder)
              Do Until Response = ""

              swFilename = folder & Response
                  If Right(UCase$(Response), 7) = ext Then
                      Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)
                      Set swModelDocExt = swModel.Extension
                      Debug.Print swFilename

                      bret = swModel.Save3(101, nErrors, nWarnings)
                      Debug.Assert bret
                      Debug.Print "   File Saved"
                      swApp.CloseAllDocuments True

                  End If
                  Response = Dir

              Dim myFolder As folder
              Dim mySub As folder
              Set myFolder = fso.GetFolder(folder)
              For Each mySub In myFolder.SubFolders
                  BatchDrwFiles mySub.Path, ext, silent
          '        Debug.Print mySub.Path

          End Sub

          Private Sub zUpdateStrings()
              Set swModel = swApp.ActiveDoc
              Set swDraw = swModel
              vSheetName = swDraw.GetSheetNames
              For i = 0 To UBound(vSheetName)
                  bret = swDraw.ActivateSheet(vSheetName(i))
                  Set swSheet = swDraw.Sheet(vSheetName(i))
                  vSheetProps = swSheet.GetProperties
                  Set swView = swDraw.GetFirstView
                  While Not swView Is Nothing
                      Set swNote = swView.GetFirstNote
                      While Not swNote Is Nothing
                          If swNote.IsCompoundNote Then
                              nTextCount = swNote.GetTextCount
                              For j = 1 To nTextCount
                                  sNoteText = swNote.GetTextAngleAtIndex(i)
                                  zDoReplaceString sNoteText
                                  If sNoteText <> "" Then
                                      swNote.SetTextAtIndex i, sNoteText
                                  End If
                              Next j
                              sNoteText = swNote.GetText
                              zDoReplaceString sNoteText
                              If sNoteText <> "" Then
                                  swNote.SetText sNoteText
                              End If
                          End If
                          Set swNote = swNote.GetNext
                      Set swView = swView.GetNextView
          End Sub

          Private Sub zInitStrings()
              OldString(0) = "OLD TEXT 0"
              OldString(1) = "OLD TEXT 1"
              OldString(2) = "OLD TEXT 2"
              NewString(0) = "NEW TEXT 0"
              NewString(1) = "NEW TEXT 1"
              NewString(2) = "NEW TEXT 2"
          End Sub
          Private Sub zDoReplaceString(ByRef sNoteText As String)
              Dim i               As Long
              Select Case sNoteText
                  Case OldString(0)
                      sNoteText = NewString(0)
                  Case OldString(1)
                      sNoteText = NewString(1)
                  Case OldString(2)
                      sNoteText = NewString(2)
                  Case Else
                      sNoteText = ""
              End Select
          End Sub


          • Re: Editing Drawing Title Block Text Macro
            Mike Helsinger

            I'm only mildly versed in macros, seizing the moment to improve my understanding.  I have a conceptual question, perhaps it could help the issue, else please don't let me distract the question too much.


            For something like this could you create a new drawing template file with the change you are making, then macro to load this template into each of your several hundred drawing files?  If so would that be easier or not necessarily?