Option Explicit
Implements EFCustomProcess.IEFCustomPublish
Dim ObjEFSrvMgrLocal As IEFCustomPublishEventHandler
Private m_oMessageIContainer As IContainer
Private m_oToolParms As IEFToolParameters
Private Const TCD_L_ERROR_NUMBER_BASE As Long = vbObjectError + 5023&
Private Const TCD_L_ERROR_GENERAL As Long = TCD_L_ERROR_NUMBER_BASE + 1
Private Const S_THIS_FILE As String = "CustomPublish"
Public Property Set IEFCustomPublish_MessageIContainer(ByVal RHS As IContainer)
Set m_oMessageIContainer = RHS
End Property
Public Property Set IEFCustomPublish_ToolParameters(ByVal RHS As IEFToolParameters)
Set m_oToolParms = RHS
End Property
Public Sub IEFCustomPublish_SetEventHandlerObj(ByVal lobjEventHandler As IEFCustomPublishEventHandler)
Set ObjEFSrvMgrLocal = lobjEventHandler
End Sub
Public Sub IEFCustomPublish_ListOfProgressSteps(ByRef parrListOfProgressSteps() As String)
ReDim parrListOfProgressSteps(0) As String
parrListOfProgressSteps(0) = "Adding new Pump(P-008)..."
End Sub
Public Sub IEFCustomPublish_ProcessPublishData(ByRef pDocObject As IObject, _
ByRef pDocContainer As IContainer, _
ByRef pMetaContainer As IContainer, _
Optional ByRef pToolMapContainer As IContainer)
On Error GoTo llblErrorHandler
ObjEFSrvMgrLocal.StepProgressBegin ("Adding new Pump(P-008)...")
Call AddNewObject(pDocObject, pDocContainer, pMetaContainer, pToolMapContainer)
ObjEFSrvMgrLocal.StepProgressEnd ("Adding new object (Vessel)...")
GoTo llblExitProcedure
llblErrorHandler:
Call ECU_HandleErrorProcessPublishDta("IEFCustomPublish_ProcessPublishData", m_oMessageIContainer, Err.Source, Err.Description, Err.Number)
llblExitProcedure:
End Sub
Public Sub AddNewObject(ByRef pDocObject As IObject, ByRef pDocContainer As IContainer, ByRef pMetaContainer As IContainer, _
Optional ByRef pToolMapContainer As IContainer)
Dim oIClassDef As IClassDef
Dim oIObject As IObject
Dim vsNameObject As Variant
Dim vsDescriptionObject As Variant
Dim sUIDClass As String
sUIDClass = "NonDrawingItem_F"
Set oIClassDef = pDocContainer.ContainerComposition.GetIObjectForUID(sUIDClass) ' Returns a pointer to the IObject interface for the object with the unique identifier sUID. For this method to succeed, the object must have been assigned to the container composition by a previous call to SetIObjectForUID.
If oIClassDef Is Nothing Then
Err.Raise TCD_L_ERROR_GENERAL, "NoClassObject", App.Title & ":ProcessPublishData function:Unable to locate class object with UID '" & sUIDClass & "' in container."
End If
Set oIObject = oIClassDef.CreateInstance(pDocContainer)
vsNameObject = "P-008"
oIObject.UID = "U1008"
vsDescriptionObject = "Pump added in CustomPublish"
Dim lobj As IObject
Set lobj = CreateObjectInContainer(pDocContainer, sUIDClass, oIObject, vsNameObject, vsDescriptionObject)
Dim oIObject1 As IObject
Dim oRelIRel As IRel
sUIDClass = "Rel"
Set oIClassDef = pDocContainer.ContainerComposition.GetIObjectForUID(sUIDClass) ' Returns a pointer to the IObject interface for the object with the unique identifier sUID. For this method to succeed, the object must have been assigned to the container composition by a previous call to SetIObjectForUID.
If oIClassDef Is Nothing Then
Err.Raise TCD_L_ERROR_GENERAL, "NoClassObject", App.Title & ":ProcessPublishData:Unable to locate class object with UID '" & sUIDClass & "' in container."
End If
Set oIObject1 = oIClassDef.CreateInstance(pDocContainer)
oIObject1.UID = "U1008Rel"
oIObject.ClassDefIObj.Name = "NonDrawingItem_F"
vsNameObject = "P-008 Rel"
vsDescriptionObject = "Rel P-008"
Dim lobjRel As IObject
Set lobjRel = CreateObjectInContainer(pDocContainer, "Rel", oIObject1, vsNameObject, vsDescriptionObject)
Set oRelIRel = lobjRel
Set oRelIRel.UID1IObj = lobj
Set oRelIRel.UID2IObj = pDocObject
oRelIRel.DefUID = "NonDrawingItemCollection"
End Sub
Public Function CreateObjectInContainer( _
ByRef oIContainer As IContainer, _
ByVal sUIDClass As String, _
ByRef sUIDObject As IObject, _
Optional ByVal vsNameObject As Variant, _
Optional ByVal vsDescriptionObject As Variant _
) As IObject
Dim oIClassDef As IClassDef
' Creates an object of this class definition type and adds it to the specified container.
If sUIDObject Is Nothing Then
Call Err.Raise(TCD_L_ERROR_GENERAL, "NoCreateObject", App.Title & ":ProcessPublishData:Unable to create object of class '" & sUIDClass & "' in container.")
End If
If Not IsMissing(vsNameObject) Then
sUIDObject.Name = CStr(vsNameObject)
End If
If Not IsMissing(vsDescriptionObject) Then
sUIDObject.Description = CStr(vsDescriptionObject)
End If
' Object to return.
Set CreateObjectInContainer = sUIDObject
End Function