---

Hi

habe mir gerade ein Macro geschrieben was automatisch den maßstab einer zeichnung ausfüllt

funktioniert soweit auch perfekt.

nun würde ich aber gerne das macro gleich über alle blätter der IDW laufen lassen, zurzeit wird der maßstab nur bei dem aktiven blatt ausgefüllt.

hier mal der code

Code:

---

Function SetPromptValue(ByVal fBlock As TitleBlock, _
ByVal fPrompt As String, _
ByVal fValue As String)
'Changes the value of prompted entry in the title block
On Error Resume Next
Dim oTextbox As Inventor.TextBox
Dim oTextBoxes As Inventor.TextBoxes
Dim sData As String

Set oTextBoxes = fBlock.Definition.Sketch.TextBoxes
For Each oTextbox In oTextBoxes
sData = Trim(fBlock.GetResultText(oTextbox))
If InStr(oTextbox.FormattedText, fPrompt) Then
Call fBlock.SetPromptResultText(oTextbox, fValue)
End If
'MsgBox oTextbox.Text & " > " & sData
Next
On Error GoTo 0
End Function

Public Sub prompt_fill()

Dim oDoc As Inventor.Document
Set oDoc = ThisApplication.ActiveDocument
Dim act_sheet As Sheet
Set act_sheet = oDoc.ActiveSheet
Dim tbdef As TitleBlock
Set tbdef = act_sheet.TitleBlock

sMassstab1 = oDoc.ActiveSheet.DrawingViews(1).ScaleString

SetPromptValue tbdef, "Massstab Einzelteil", sMassstab1

  Dim myidw As DrawingDocument
    Set myidw = ThisApplication.ActiveDocument

    Dim oSS As SketchedSymbol

    For Each oSS In myidw.ActiveSheet.SketchedSymbols

        If oSS.Definition.Name = "Zusatzschriftfeld 2" Then
          Set otext = oSS.Definition.Sketch.TextBoxes.Item(4)
Call oSS.SetPromptResultText(otext, sMassstab1)
        End If
    Next
   

End Sub

---

hoffe mir kann jemand weiterhelfen

Danke schonmal

Dero

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

so habe es geschafft.

hier mal der code falls es jemanden interessiert.

Code:

---

Public Sub Maßstab()

Dim oSourceDocument As DrawingDocument
    Set oSourceDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet
    For Each oSheet In oSourceDocument.Sheets
        oSheet.Activate
Call prompt_fill
Next

 

End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP