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

    Editing Drawing Title Block Text Macro

    Kieran Hickman

      Hi,
      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 = _

      Application.SldWorks

       

      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.EditTemplate

      Part.EditSketch

      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

          Kieran,

            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.

           

          Paul

           

           

          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
              zInitStrings
             
              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

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

                  End If
                  Response = Dir
              Loop

              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
              Next

          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
                          Else
                              sNoteText = swNote.GetText
                              zDoReplaceString sNoteText
                              If sNoteText <> "" Then
                                  swNote.SetText sNoteText
                              End If
                          End If
                     
                          Set swNote = swNote.GetNext
                      Wend
             
                      Set swView = swView.GetNextView
                  Wend
              Next
          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?