Sheet re-numbering

[LucasC]

Is there a way to extract numeric values from a string? I cant use "Val" as it only gets the value from left to right. example: "Sheet 15" I just need the 15, and the numbers are always on the right. I'm running into problems when it goes to double digits. Otherwise I would just use the "right(str), 1" method(if i use ,2... it causes problems downstream by adding an extra space). The first portion of code renames all the sheets in the format of Sheet 1, Sheet 2, etc and works fine. But like I said earlier, the trouble is when I have double digits in the sheet count.

Also, I don't necessarily need to extract this from the sheet name. If there's another way to get the current sheet number, fine by me.

Dim TitleBlockTexts As DrawingTexts
Set TitleBlockTexts = DrawingDoc1.sheets.ActiveSheet.views.Item("Background View").Texts

Dim SheetNum
Set SheetNum = TitleBlockTexts.GetItem("TitleBlock_Text_Sheet")

Dim SheetOfText
SheetOfText = "OF"
  
SheetNum.Text = UCase([COLOR=#EF2929]'Need this portion'[/color] & " " & SheetOfText & " " & Title_Block.Total_Sheet_TB.Value)

 

[weagan22]

Really simple google search here (I included the code for you below to save you the copy/paste):
How to find numbers from a string?

Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '

' Initialise return string to empty '
retval = ""

' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next

' Then return the return string. '
onlyDigits = retval
End Function

 

[LWolf]

in your case, since there is a space between the "sheet" and the number, just do a myarray=split(SheetNum," ")
it will produce an array with myarray(0) having "sheet" and myarrray(1) having the STRING number.

regards,
LWolf

 

[LucasC]

Thanks for the replies,

Weagan22; I did find that exact post and another few, but when I tried those codes, it resulted in a repeating value to infinity.

It's giving a object required error when I'm trying to pull the sheet name even though that code works above for the initial re-name...

Dim DrawingDoc1 As DrawingDocument
Set DrawingDoc1 = CATIA.ActiveDocument

Dim Sheet_Count As Integer
Sheet_Count = DrawingDoc1.sheets.Count

'Re-Name all sheets
Dim DSheet As DrawingSheet
For Each DSheet In DrawingDoc1.sheets

Dim n As Integer
n = n + 1

DrawingDoc1.sheets.Item(n).Name = "Sheet" & " " & n

'Title Block Sheet Re-Number

Dim TitleBlockTexts As DrawingTexts
Set TitleBlockTexts = DrawingDoc1.sheets.ActiveSheet.views.Item("Background View").Texts

Dim SheetNum
Set SheetNum = TitleBlockTexts.GetItem("TitleBlock_Text_Sheet")

Dim SheetOfText As String
SheetOfText = "OF"

Dim SheetName
Set SheetName = DrawingDoc1.sheets.Item(n).Name   '[COLOR=#EF2929]<---- Object required error[/color]

Dim PageNum(2)
PageNum = Split(SheetName, " ")
  
SheetNum.Text = UCase(PageNum(1) & " " & SheetOfText & " " & Sheet_Count)

 

[weagan22]

Get rid of the set statement, you only need that if you are applying an object to a variable (you are only trying to apply a string to a variable). You can also just reference the "DSheet" that you are using for your loop. Finally, you would plug that variable into the function that I provided and it will return the number you are after (Obviously you need to copy that function into your module as well). It should read:

Dim SheetName as String
SheetName = DSheet.Name

Dim SheetNum as String
SheetNum = onlyDigits(SheetName)

 

[LucasC]

both suggestions worked, I went with LWolfs for the sake of simplicity.

the re-name works correctly on all sheets but the renumber only works on 1 page. should I split these two up with separate for...each statements?

Dim DrawingDoc1 As DrawingDocument
Set DrawingDoc1 = CATIA.ActiveDocument

Dim Sheet_Count As Integer
Sheet_Count = DrawingDoc1.sheets.Count

'Re-Name all sheets
Dim DSheet As DrawingSheet
For Each DSheet In DrawingDoc1.sheets

Dim n As Integer
n = n + 1

DrawingDoc1.sheets.Item(n).Name = "Sheet" & " " & n

'Title Block Sheet Re-Number

Dim TitleBlockTexts As DrawingTexts
Set TitleBlockTexts = DrawingDoc1.sheets.ActiveSheet.views.Item("Background View").Texts

Dim SheetNum
Set SheetNum = TitleBlockTexts.GetItem("TitleBlock_Text_Sheet")

Dim SheetOfText As String
SheetOfText = "OF"

Dim SheetName
SheetName = DrawingDoc1.sheets.[highlight #FCE94F]ActiveSheet.Name[/highlight] [COLOR=#EF2929]Changed this, sheets.item(n) was returning the total number[/color]
Dim PageNum
PageNum = Split(SheetName, " ")
  
SheetNum.Text = UCase(PageNum(1) & " " & SheetOfText & " " & Sheet_Count)

Dim StringStart
StringStart = Len(PageNum(1) + " ") + 1

Dim StringLength
StringLength = Len(SheetOfText)

SheetNum.SetFontSize StringStart, StringLength, 1.5
Next

 

[LucasC]

Got it to work by keeping just one for..each loop and adding sheet.activate prior to the re-number portion.

Thanks for the advice.

 

[weagan22]

This is how I would accomplish what you are after (I added a bit of error handling as well):

Sub CATMain()
    'Check to make sure the active document is a drawing
    If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
        Err.Raise 555, "Sheet Number", "Sheet number macro only works for drawings."
    End If
    
    'Get the active document
    Dim ActiveDrawing As DrawingDocument
    Set ActiveDrawing = CATIA.ActiveDocument
    
    Dim Sheet_Count As Integer
    Sheet_Count = ActiveDrawing.Sheets.Count
    
    'Declare the sheet number counter and initialize to 1
    Dim CurNum As Integer
    CurNum = 1
    
    'Loop through all of the sheets of the active document
    Dim DSheet As DrawingSheet
    For Each DSheet In ActiveDrawing.Sheets
        
        'Check to see if the sheet is a detail sheet
        Dim IsDetailSheet As Boolean
        IsDetailSheet = DSheet.IsDetail
    
        'If it is a detail sheet skip to the next sheet
        If IsDetailSheet = False Then
            'Rename the sheet
            DSheet.Name = "Sheet " & CurNum
            
            'Get the texts in the background
            Dim TitleBlockTexts As DrawingTexts
            Set TitleBlockTexts = DSheet.Views.Item("Background View").Texts
            
            'Block errors from happening and try to get the TitleBlock_Text_Sheet
            On Error Resume Next
            Dim TxtSheetNum As DrawingText
            Set TxtSheetNum = Nothing 'For some reason I needed this because it wasn't dropping the value from the last loop. Not sure why; it should be.
            Set TxtSheetNum = TitleBlockTexts.GetItem("TitleBlock_Text_Sheet")
            On Error GoTo 0
            
            'Add a text box if one does not exist
            If TxtSheetNum Is Nothing Then
                Set TxtSheetNum = TitleBlockTexts.Add("", 0, 0)
                TxtSheetNum.Name = "TitleBlock_Text_Sheet"
            End If
            
            'Add your TB coordinates and anchor point here (this will add consistency to your srawing and make sure to fix it if the user moves it for some reason
            TxtSheetNum.AnchorPosition = catMiddleCenter
            TxtSheetNum.X = 0
            TxtSheetNum.Y = 0
            
            'Build the input string for the sheet number
            Dim SheetOfText As String
            SheetOfText = "OF"
              
            Dim SheetNumStr As String
            SheetNumStr = UCase(CurNum & " " & SheetOfText & " " & Sheet_Count)
              
            'Input the string into the textbox
            TxtSheetNum.Text = SheetNumStr
            
            'Format the SheetOfText string
            TxtSheetNum.SetFontSize InStr(1, SheetNumStr, SheetOfText), Len(SheetOfText), 1.5
            
            'Increment the sheet number counter
            CurNum = CurNum + 1
        End If
    Next
End Sub

 

[LucasC]

I have the additional features you added in other areas. for example, this userform(title block editor) wont launch if a drawing document is not open. It also won't open if all the features on the drawing template are not present. I just implemented this about a year ago so there are many old drawings that are not compatible and I want the users to update them.

What does Err.Raise 555, "Sheet Number", do? is this some other form of a msgbox?

 

[weagan22]

It raises an error box with the information provided, it does this if the active document isn't a drawing.

 

[weagan22]

To add to this, you should be able to automatically update old drawings; all the information is there. Just take what is there, blow away the old format, redraw the form and then populate the values.

 

[LucasC]

I run into issues with the names of the existing revision column and other items, they are not all named the same. they are random like text.2, text.17, etc. I can handle the reformatting and data population, I just don't have the experience to figure out how to deal with the random naming of all the text boxes and tables.

This is how I did mine, I've just never seen err.raise 555 before.

If InStr(drawingDocument1.Name, ".CATDrawing") = 0 Then
MsgBox "The Active Document must be a CATDrawing."
Exit Sub
End If

 

[weagan22]

I'm assuming that the texts are always in the same place on the sheet. You could check that the x/y coordinates are within a certain rage to determine what textbox is which.

That 100% works for error handling. It's usually better practice to check the "ActiveDocument" so that it directly checking that, but that is really just semantics.

 

[LucasC]

nope, title blocks/frames have changed many times over the years compounded by users manually adjusting them if they change sheet size among other reasons. Not all of our locations use the tool I'm developing and some use completely different ones developed independently. I was late to the party, the other 2 people that develop already had the named textboxes/tables in place so I followed suit.

 

[weagan22]

Sounds like a mess.

To tag into the previous posts, it really doesn't hurt to repeat error handling in this macro as it makes it more robust and standalone is case someone else at your company takes it and tries to use it somewhere else.