Code:
Imports Inventor
Imports System.Runtime.InteropServices
Imports Microsoft.Win32Namespace TestSpeichernNeuinstallation
<ProgIdAttribute("TestSpeichernNeuinstallation.StandardAddInServer"), _
GuidAttribute("f01145cb-dd0d-411b-9975-e49a219b849d")> _
Public Class StandardAddInServer
Implements Inventor.ApplicationAddInServer
' Inventor application object.
Private m_inventorApplication As Inventor.Application
Private WithEvents m_appEvents As Inventor.ApplicationEvents
#Region "ApplicationAddInServer Members"
Public Sub Activate(ByVal addInSiteObject As Inventor.ApplicationAddInSite, ByVal firstTime As Boolean) Implements Inventor.ApplicationAddInServer.Activate
' This method is called by Inventor when it loads the AddIn.
' The AddInSiteObject provides access to the Inventor Application object.
' The FirstTime flag indicates if the AddIn is loaded for the first time.
' Initialize AddIn members.
m_inventorApplication = addInSiteObject.Application
m_appEvents = m_inventorApplication.ApplicationEvents
' TODO: Add ApplicationAddInServer.Activate implementation.
' e.g. event initialization, command creation etc.
End Sub
Public Sub Deactivate() Implements Inventor.ApplicationAddInServer.Deactivate
' This method is called by Inventor when the AddIn is unloaded.
' The AddIn will be unloaded either manually by the user or
' when the Inventor session is terminated.
' TODO: Add ApplicationAddInServer.Deactivate implementation
' Release objects.
Marshal.ReleaseComObject(m_inventorApplication)
m_inventorApplication = Nothing
System.GC.WaitForPendingFinalizers()
System.GC.Collect()
End Sub
Public ReadOnly Property Automation() As Object Implements Inventor.ApplicationAddInServer.Automation
' This property is provided to allow the AddIn to expose an API
' of its own to other programs. Typically, this would be done by
' implementing the AddIn's API interface in a class and returning
' that class object through this property.
Get
Return Nothing
End Get
End Property
Public Sub ExecuteCommand(ByVal commandID As Integer) Implements Inventor.ApplicationAddInServer.ExecuteCommand
' Note:this method is now obsolete, you should use the
' ControlDefinition functionality for implementing commands.
End Sub
Private Sub m_appEvents_OnSaveDocument( _
ByVal DocumentObject As Inventor._Document, _
ByVal BeforeOrAfter As Inventor.EventTimingEnum, _
ByVal Context As Inventor.NameValueMap, _
ByRef HandlingCode As Inventor.HandlingCodeEnum) _
Handles m_appEvents.OnSaveDocument
Dim dateiformat As String
dateiformat = DocumentObject.FullFileName
dateiformat = dateiformat.Substring(dateiformat.Length - 4)
If dateiformat = ".idw" Then
If BeforeOrAfter = EventTimingEnum.kBefore Then
If DocumentObject.DocumentType = DocumentTypeEnum.kDrawingDocumentObject Then
Dim sPartNumber As String
sPartNumber = DocumentObject.ReferencedDocuments(1).PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").Item("Part Number").Value
Dim sRevision As String
sRevision = DocumentObject.PropertySets.Item("{F29F85E0-4FF9-1068-AB91-08002B27B3D9}").Item("Revision Number").Value
If sRevision = "" Then sRevision = "0"
Dim filename As String
filename = DocumentObject.FullFileName
filename = Left(filename, Len(filename) - 4)
filename = sPartNumber & "#" & sRevision & "#"
' Save the current SilentOperation and then turn it on.
'This will suppress the dwf viewer from being displayed.
Dim currentSetting As Boolean
currentSetting = m_inventorApplication.SilentOperation
m_inventorApplication.SilentOperation = True
Dim oPDFTrans As TranslatorAddIn
oPDFTrans = m_inventorApplication.ApplicationAddIns.ItemById( _
"{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
If oPDFTrans Is Nothing Then
MsgBox("Could not access PDF translator.")
Exit Sub
End If
' Create some objects that are used to pass information to the translator Add-In.
Dim oContext As TranslationContext
oContext = m_inventorApplication.TransientObjects.CreateTranslationContext
Dim oOptions As NameValueMap
oOptions = m_inventorApplication.TransientObjects.CreateNameValueMap
If oPDFTrans.HasSaveCopyAsOptions(m_inventorApplication.ActiveDocument, _
oContext, oOptions) Then
' Set to print all sheets. This can also have the value
' kPrintCurrentSheet or kPrintSheetRange. If kPrintSheetRange
' is used then you must also use the CustomBeginSheet and
' Custom_End_Sheet to define the sheet range.
oOptions.Value("Sheet_Range") = PrintRangeEnum.kPrintAllSheets
' Other possible options...
'oOptions.Value("Custom_Begin_Sheet") = 1
'oOptions.Value("Custom_End_Sheet") = 5
'oOptions.Value("All_Color_AS_Black") = True
'oOptions.Value("Remove_Line_Weights") = True
'oOptions.Value("Vector_Resolution") = 200
' Define various settings and input to provide the translator.
oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
Dim oData As DataMedium
If MsgBox("Wollen Sie die Zeichnung nach D3 exportieren?", vbYesNo + vbDefaultButton2, "Speicherort") = vbYes Then
If MsgBox("Sind Sie sich wirklich sicher, dass die Zeichnung nach D3 expotieren wollen?", vbYesNo + vbDefaultButton2, "Speicherort") = vbYes Then
If My.Computer.FileSystem.FileExists("C:\Test\" & filename & ".pdf") Then
If MsgBox("Die Datei exisitert bereits. Soll die Zeichnung überschrieben werden?", vbYesNo + vbDefaultButton2, "Überschreiben") = vbYes Then
oData = m_inventorApplication.TransientObjects.CreateDataMedium
oData.FileName = "C:\Test\" & filename & ".pdf"
MsgBox("Die Datei wurde auf dem Server gespeichert")
Else
MsgBox("Die Datei wurde nicht überschrieben")
' eventuell Code hinzfügen : Wollen Sie die Datei unter anderem Namen speichern?
End If
End If
oData = m_inventorApplication.TransientObjects.CreateDataMedium
oData.FileName = "C:\Test\" & filename & ".pdf"
MsgBox("Die Datei wurde auf dem Server gespeichert")
Call oPDFTrans.SaveCopyAs(m_inventorApplication.ActiveDocument, _
oContext, oOptions, oData)
m_inventorApplication.SilentOperation = currentSetting
End If
End If
End If
End If
End If
End If
End Sub
#End Region
End Class
End Namespace
Foren auf CAD.de (alle Foren)
| 
