Public Sub Main ()
'Check Title in active document
Try
Dim odrawdoc As DrawingDocument
odrawdoc = ThisApplication.ActiveDocument
' Check if drawing deferupdate state is true
If Not odrawdoc.DrawingSettings.DeferUpdates = "False" Then
'ShowError("Can`t change Title because drawing file is Deferupdate")
Exit Sub
End If
'Sostituisco i simboli nel disegno
Try
deletesymbols
'CopySymbols
Catch
End Try
Dim Title="cartiglio-2019"
Call ReplaceTitle(Title)
Catch
MsgBox("Errore durante sostituzione cartiglio")
End Try
End Sub
Sub ReplaceTitle(ByRef Title As String )
Dim odrawdoc As DrawingDocument
odrawdoc = ThisApplication.ActiveDocument
Dim Template = "C:\Impostazioni_Inventor\2018\Templates\2019 Standard.idw"
Dim oTemplate As DrawingDocument
Dim oSourceTitleBlockDef As TitleBlockDefinition
Dim oNewTitleBlockDef As TitleBlockDefinition
Dim oSheet = odrawdoc.ActiveSheet
Try
'Apro il template
oTemplate = ThisApplication.Documents.Open(Template, False)
'Aggancio la definizione del nuovo cartiglio
oSourceTitleBlockDef = oTemplate.TitleBlockDefinitions.Item(Title)
'Copio la definizinoe del cartiglio nel nuovo disegno
oNewTitleBlockDef = oSourceTitleBlockDef.CopyTo(odrawdoc, True)
'Chiudo il template
oTemplate.Close
'MsgBox("Tentativo di inserimento cartiglio " & Title)
'Inserimento cartiglio sul disegno
' Dim i As Integer
' Dim intPrompts As Integer = 0
' For i = 1 To oNewTitleBlockDef.Sketch.TextBoxes.Count
' Dim oText = oNewTitleBlockDef.Sketch.TextBoxes(i)
' If (oText.Text = "MY_PROMPT")
' intPrompts = intPrompts + 1
' End If
' Next
'MsgBox ("Trovati " & intPrompts & " messaggi prompt")
Dim oPrompts(2) As String
oPrompts(0) = ""
oPrompts(1) = ""
oPrompts(2) = ""
oSheet.TitleBlock.Delete()
oSheet.AddTitleBlock(oNewTitleBlockDef,,oPrompts)
'MsgBox("Title Block changed to " & vbCr & Title)
Catch ex As Exception
MsgBox("Errore: " & ex.Message)
End Try
End Sub
Sub deletesymbols
Dim oDoc As DrawingDocument = ThisDoc.Document
Dim oSkSymDefs As SketchedSymbolDefinitions = oDoc.SketchedSymbolDefinitions
Dim oSkSymDef As SketchedSymbolDefinition
For Each oSkSymDef In oSkSymDefs
If oSkSymDef.IsReferenced = False Then
oSkSymDef.Delete
End If
Next
End Sub
Sub CopySymbols
Dim strSelectedStamp As String = "Result2"
Dim strStampList As New ArrayList
Dim strStampRequired As Boolean
strStampRequired = True
strStampList.Add("cartilgio-2019")
'strStampList.Add("X OSSITAGLIO")
'strStampList.Add("Test")
strSelectedStamp = InputListBox("Please select a stamp.", strStampList, strSelectedStamp, "Stamp Selection", "Available Stamps")
Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
Dim SourceFile As String = "M:\_Impostazioni_Inventor\2018\Templates\2019 Standard.idw"
Dim strSourceIDW As DrawingDocument
strSourceIDW = ThisApplication.Documents.Open(SourceFile, False)
Dim symbolDef As SketchedSymbolDefinition
Dim CopyFrom As SketchedSymbolDefinition
Try
For Each symbolDef In strSourceIDW.SketchedSymbolDefinitions
CopyFrom = (symbolDef.CopyTo(strDrawDoc, True))
Next
Catch ex As Exception
MessageBox.Show(ex.Message, "Title")
End Try
strSourceIDW.Close()
End Sub
