Skip to main content
J
JanKirsten1-Visitor
1-Visitor
March 10, 2018
Solved

VBA Macro in Excel to replace drawing format to new company standard---Need help Please

  • March 10, 2018
  • 1 reply
  • 4768 views

This is what I have so far. Problem comes in when trying to select & delete the format tables on each sheet. Been at this for 2 weeks already and probably have 2 more to go at this pace.

 

Any help would be greatly appreciated. Help files not very helpful.

 

Public Sub change_sheet_parameter()
        Dim conn As IpfcAsyncConnection
        Dim cAC As CCpfcAsyncConnection
        Dim CreoSession As IpfcBaseSession
        Dim CreoDRW As IpfcModel
        Dim sheetData As IpfcSheetData
        Dim sheetowner As IpfcSheetOwner
        Dim ModelItem As New CMpfcModelItem
        Dim sheetInfo As IpfcSheetInfo
       
        Dim paramOwn As IpfcParameterOwner
       
        Dim ipREVISION_LEVEL As IpfcParameter
        Dim ipbREVISION_LEVEL As IpfcBaseParameter
        Dim pnREVISION_LEVEL As String
        Dim REVISION_LEVELnv As IpfcParamValue
       
        Dim ipDRAWING_NUMBER As IpfcParameter
        Dim ipbDRAWING_NUMBER As IpfcBaseParameter
        Dim pnDRAWING_NUMBER As String
        Dim DRAWING_NUMBERnv As IpfcParamValue
       
        Dim ipRMSS_APPROVED As IpfcParameter
        Dim ipbRMSS_APPROVED As IpfcBaseParameter
        Dim pnRMSS_APPROVED As String
        Dim RMSS_APPROVEDnv As IpfcParamValue
       
        Dim ipRMSS_APPROVE_DATE As IpfcParameter
        Dim ipbRMSS_APPROVE_DATE As IpfcBaseParameter
        Dim pnRMSS_APPROVE_DATE As String
        Dim RMSS_APPROVE_DATEnv As IpfcParamValue
       
        Dim ipRMSS_CUSTOMER_REV As IpfcParameter
        Dim ipbRMSS_CUSTOMER_REV As IpfcBaseParameter
        Dim pnRMSS_CUSTOMER_REV As String
        Dim RMSS_CUSTOMER_REVnv As IpfcParamValue
       
        Dim ipRMSS_DRAWN_BY As IpfcParameter
        Dim ipbRMSS_DRAWN_BY As IpfcBaseParameter
        Dim pnRMSS_DRAWN_BY As String
        Dim RMSS_DRAWN_BYnv As IpfcParamValue
       
        Dim ipRMSS_ECO_NUM As IpfcParameter
        Dim ipbRMSS_ECO_NUM As IpfcBaseParameter
        Dim pnRMSS_ECO_NUM As String
        Dim TRMSS_ECO_NUMnv As IpfcParamValue
       
        Dim ipRMSS_ENGR As IpfcParameter
        Dim ipbRMSS_ENGR As IpfcBaseParameter
        Dim pnRMSS_ENGR As String
        Dim RMSS_ENGRnv As IpfcParamValue
       
        Dim ipRMSS_PART_NUM As IpfcParameter
        Dim ipbRMSS_PART_NUM As IpfcBaseParameter
        Dim pnRMSS_PART_NUM As String
        Dim RMSS_PART_NUMnv As IpfcParamValue
       
        Dim ipRMSS_REV As IpfcParameter
        Dim ipbRMSS_REV As IpfcBaseParameter
        Dim pnRMSS_REV As String
        Dim RMSS_REVnv As IpfcParamValue
       
        Dim ipRMSS_REV_DESCR As IpfcParameter
        Dim ipbRMSS_REV_DESCR As IpfcBaseParameter
        Dim pnRMSS_REV_DESCR As String
        Dim TRMSS_REV_DESCRnv As IpfcParamValue
       
pnDRAWING_NUMBER = "DRAWING_NUMBER"
pnREVISION_LEVEL = "REVISION_LEVEL"
pnRMSS_APPROVED = "RMSS_APPROVED"
pnRMSS_APPROVE_DATE = "RMSS_APPROVE_DATE"
pnRMSS_CUSTOMER_REV = "RMSS_CUSTOMER_REV"
pnRMSS_DRAWN_BY = "RMSS_DRAWN_BY"
pnRMSS_ECO_NUM = "RMSS_ECO_NUM"
pnRMSS_ENGR = "RMSS_ENGR"
pnRMSS_PART_NUM = "RMSS_PART_NUM"
pnRMSS_REV = "RMSS_REV"
pnRMSS_REV_DESCR = "RMSS_REV_DESCR"

        
        Dim workDir As String
        Dim sFileName As String
   workDir = "C:\Users\jakirsten\Documents\Creo_TEMP"

'MsgBox "Run 01_PURGE_FIRST_Jan.exe First!!!"

Set cAC = New CCpfcAsyncConnection
Set conn = cAC.Connect("", "", ".", 5)
Set CreoSession = conn.session
CreoSession.ChangeDirectory (workDir)


Dim oModelDescriptorCreate As New CCpfcModelDescriptor
Dim oModelDescriptor As IpfcModelDescriptor
sFileName = Dir(CreoSession.GetCurrentDirectory & "\*.drw*")
'sFileName = "4360120-01.drw" 'Name of the drawing


Do Until sFileName = ""
        Debug.Print sFileName
        Set oModelDescriptor = oModelDescriptorCreate.Create(EpfcMDL_DRAWING, sFileName, Null)
        Set CreoDRW = CreoSession.RetrieveModel(oModelDescriptor)
        Set sheetowner = CreoDRW
        Dim oWindow As pfcls.IpfcWindow
        Set oWindow = CreoSession.OpenFile(oModelDescriptor)
        oWindow.Activate
        'sheetowner.RegenerateSheet (1)
        Dim curSheetNum As Long
        Dim totalSheets As Long
        Dim sheetStep As Long
         curSheetNum = sheetowner.CurrentSheetNumber
         totalSheets = sheetowner.NumberOfSheets
        
         For sheetStep = curSheetNum To totalSheets
            Dim tableObj As IpfcTableOwner
            Dim tableToDelete As IpfcTableOwner
            Dim table_list As CpfcTables
            Dim tableInfo As CpfcTable
            Dim CurTABLE As IpfcTable
            Dim tblCount, tblStp As Integer
           
            Set tableObj = sheetowner
            Set table_list = tableObj.ListTables
           
                tblCount = table_list.Count
           
            For tblStp = 0 To tblCount - 1
                Set CurTABLE = table_list.item(tblStp)
               ' Set tableToDelete = CurTABLE
                'tableInfo = CurTABLE
                'Debug.Print tableInfo.GetName & " is table name"
                If (CurTABLE.CheckIfIsFromFormat(sheetStep) = True And CurTABLE.GetSegmentSheet(0) = sheetStep) Then
               
                   'Set tableToDelete = CurTABLE
                    'tabletodelete.DeleteTable(CurTABLE, False) <-------------------------------------Cannot get this to work
                    Debug.Print tblStp & " is a format table"
                Else
                    Debug.Print tblStp & " NOT A FORMAT TABLE"
                End If
               
                tblStp = tblStp + 1
            Next tblStp
            tblStp = 0
        
         Next sheetStep
         sheetStep = 0
        
       
       
       
       
        Set paramOwn = CreoDRW
       
'        Set ipTITLE1 = paramOwn.GetParam(pnTITLE1)
'        Set ipbTITLE1 = ipTITLE1
       
        Set ipREVISION_LEVEL = paramOwn.GetParam(pnREVISION_LEVEL)
        Set ipbREVISION_LEVEL = ipREVISION_LEVEL
       
        Set ipDRAWING_NUMBER = paramOwn.GetParam(pnDRAWING_NUMBER)
        Set ipbDRAWING_NUMBER = ipDRAWING_NUMBER
       
        Set ipRMSS_APPROVED = paramOwn.GetParam(pnRMSS_APPROVED)
        Set ipbRMSS_APPROVED = ipRMSS_APPROVED
       
        Set ipRMSS_APPROVE_DATE = paramOwn.GetParam(pnRMSS_APPROVE_DATE)
        Set ipbRMSS_APPROVE_DATE = ipRMSS_APPROVE_DATE
       
        Set ipRMSS_CUSTOMER_REV = paramOwn.GetParam(pnRMSS_CUSTOMER_REV)
        Set ipbRMSS_CUSTOMER_REV = ipRMSS_CUSTOMER_REV
     
        Set ipRMSS_DRAWN_BY = paramOwn.GetParam(pnRMSS_DRAWN_BY)
        Set ipbRMSS_DRAWN_BY = ipRMSS_DRAWN_BY
       
        Set ipRMSS_ECO_NUM = paramOwn.GetParam(pnRMSS_ECO_NUM)
        Set ipbRMSS_ECO_NUM = ipRMSS_ECO_NUM
       
        Set ipRMSS_ENGR = paramOwn.GetParam(pnRMSS_ENGR)
        Set ipbRMSS_ENGR = ipRMSS_ENGR
       
        Set ipRMSS_PART_NUM = paramOwn.GetParam(pnRMSS_PART_NUM)
        Set ipbRMSS_PART_NUM = ipRMSS_PART_NUM
       
        Set ipRMSS_ENGR = paramOwn.GetParam(pnRMSS_ENGR)
        Set ipbRMSS_ENGR = ipRMSS_ENGR
       
        Set ipRMSS_REV = paramOwn.GetParam(pnRMSS_REV)
        Set ipbRMSS_REV = ipRMSS_REV
       
        Set ipRMSS_REV_DESCR = paramOwn.GetParam(pnRMSS_REV_DESCR)
        Set ipbRMSS_REV_DESCR = ipRMSS_REV_DESCR
       
        Set DRAWING_NUMBERnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B9").Value)
        Set REVISION_LEVELnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B10").Value)
        Set RMSS_APPROVEDnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B11").Value)
        Set RMSS_APPROVE_DATEnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B12").Value)
        Set RMSS_CUSTOMER_REVnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B13").Value)
        Set RMSS_DRAWN_BYnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B14").Value)
        Set RMSS_ECO_NUMnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B15").Value)
        Set RMSS_ENGRnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B16").Value)
        Set RMSS_PART_NUMnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B17").Value)
        Set RMSS_REVnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B18").Value)
        Set RMSS_REV_DESCRnv = ModelItem.CreateStringParamValue(sheets("Parameters").Range("B19").Value)
               
        ipbDRAWING_NUMBER.Value = DRAWING_NUMBERnv
        ipbREVISION_LEVEL.Value = REVISION_LEVELnv
        ipbRMSS_APPROVED.Value = RMSS_APPROVEDnv
        ipbRMSS_APPROVE_DATE.Value = RMSS_APPROVE_DATEnv
        ipbRMSS_CUSTOMER_REV.Value = RMSS_CUSTOMER_REVnv
        ipbRMSS_DRAWN_BY.Value = RMSS_DRAWN_BYnv
        ipbRMSS_ECO_NUM.Value = RMSS_ECO_NUMnv
        ipbRMSS_ENGR.Value = RMSS_ENGRnv
        ipbRMSS_PART_NUM.Value = RMSS_PART_NUMnv
        ipbRMSS_REV.Value = RMSS_REVnv
        ipbRMSS_REV_DESCR.Value = RMSS_REV_DESCRnv
      

      
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
       
        oWindow.Close
        'CreoSession.EraseUndisplayedModels
        sFileName = Dir

Loop


'End the Creo Parametric session when done
''''If Not conn Is Nothing Then
''''    If conn.IsRunning Then
''''        conn.End
''''    End If
''''End If
''''RunError:
''''    If Err.Number <> 0 Then
''''        MsgBox "Process Failed : Unknown error occured." + Chr(13) + _
''''        "Error No: " + CStr(Err.Number) + Chr(13) + _
''''        "Error: " + Err.Description, vbCritical, "Error"
''''        If Not conn Is Nothing Then
''''            If conn.IsRunning Then
''''            conn.End
''''            End If
''''        End If
''''    End If
   
Set cAC = Nothing
Set conn = Nothing
Set CreoSession = Nothing
Set CreoDRW = Nothing
End Sub

Best answer by JanKirsten

After fighting this for 4 weeks finally got it solved. Had a lot of help from Liu at PTC tech support. Sharing so if someone wants to do the same thing, then he/she would not have to re-invent the wheel. This works on Creo 3.0. using Excel VBA.

 

Public Sub ReplaceSheetFormats()
   
    'On Error GoTo RunError 'and run KillCreoAfterCrash1
       
        'MsgBox "Run 01_PURGE_FIRST_Jan.exe First!!!" '<----------------------- Would like to run a PURGE on this directory before everything started but suspect something is wron in my settings. Is there an easy way to do??
       
        '------Setup connection to Creo
        Dim conn As IpfcAsyncConnection
        Dim cAC As CCpfcAsyncConnection
        Dim CreoSession As IpfcBaseSession
            Set cAC = New CCpfcAsyncConnection
            Set conn = cAC.start("C:\Program Files\PTC\Creo 3.0\M070\Parametric\bin\parametric.exe", Null)
            Set CreoSession = conn.session
        Dim workDir As String
            workDir = "C:\Users\jakirsten\Documents\Creo_TEMP"
            CreoSession.ChangeDirectory (workDir)
        '-----Connected & changed working directory
       
'        Dim dwFilesLists As Istringseq
'            Set dwFilesLists = CreoSession.ListFiles("*.drw", EpfcFILE_LIST_LATEST, workDir)
        Dim sFileName As String
           sFileName = Dir(CreoSession.GetCurrentDirectory & "\*.drw*")
            'sFileName = "4360120-01.drw" 'Name of the drawing
       
Do Until sFileName = ""   'See Loop down below all this is done on each drawing in the directory
        'Debug.Print sFileName
        Dim descModelCreate As CCpfcModelDescriptor
        Dim descModel As IpfcModelDescriptor
        Dim CreoModel As IpfcModel
            Set descModelCreate = New CCpfcModelDescriptor
            Set descModel = descModelCreate.Create(EpfcModelType.EpfcMDL_DRAWING, sFileName, Null)
            Set CreoModel = CreoSession.RetrieveModel(descModel)
       
        Dim oWindow As pfcls.IpfcWindow
            Set oWindow = CreoSession.OpenFile(descModel)
            oWindow.Activate
       
        Dim thisDrawingName As String
            thisDrawingName = CreoModel.CommonName
       
        'VB api process calls and other processing to be done
        Dim sheetOwner As IpfcSheetOwner
        Dim sheetInfo As IpfcSheetInfo
        Dim totalSheets As Long
        Dim sheetStep As Long
            Set sheetOwner = CreoModel
            totalSheets = sheetOwner.NumberOfSheets
           
        sheetOwner.CurrentSheetNumber = 1
        sheetOwner.RegenerateSheet (1)
           
        'First delete all format tables from all sheets
        Dim tableOwner As IpfcTableOwner
        Set tableOwner = CreoSession.CurrentModel
   
        Dim tables As IpfcTables
        Set tables = tableOwner.ListTables()
       
        Dim i As Integer
        For i = 0 To tables.Count - 1
            If tables.item(i).CheckIfIsFromFormat(i) = True Then
                tableOwner.DeleteTable tables.item(i), True  '<-------------------Thank you so much Frank you are a genius!!! it works great!!!
            End If
        Next i
          Set tables = tableOwner.ListTables() 'just to check tables has been deleted

'++++++++++++++++++++++++Deleting balloons+++++++++++++++++++++++++++++++ Code from Frank Liu....thank you
    Dim mdlItemOwner As IpfcModelItemOwner
        Set mdlItemOwner = CreoSession.CurrentModel
    Dim symInsts As IpfcModelItems
        Set symInsts = mdlItemOwner.ListItems(EpfcModelItemType.EpfcITEM_DTL_SYM_INSTANCE)
   
    For i = 0 To symInsts.Count - 1
        Dim symInst As IpfcDetailSymbolInstItem
            Set symInst = symInsts.item(i)
       
        Dim symInstDefName As String
        symInstDefName = symInst.GetInstructions(False).symbolDef.GetInstructions().name
        'If symInstDefName Like "*REV*" Then
        If StrComp(UCase(symInstDefName), "REV", vbTextCompare) = 0 Then
            On Error Resume Next
            symInst.Remove
            On Error GoTo 0
        End If
Next
'++++++++++++++++++++++++Deleting balloons+++++++++++++++++++++++++++++++
       
        'Now set parameters for sheetformat: ECO, dates, engineer,... and all that
    'From Medtronic parameters 3/22/18
    'WM=Windchill rev & not editable
    'PTC_WM_REVISION same as REVISION_LEVEL
    'REVISION_LEVEL   ---- is it safe to use this?
    'DRAWING_NUMBER ----not neccisarily Part Number----find partnumber variable!
    '&DRAWING_NUMBER:D   --- is this the exact variable?
    'ITEM_DESCRIPTION
       
        Dim paramOwn As IpfcParameterOwner
            Set paramOwn = CreoModel
        Dim CreoModelItem As CMpfcModelItem
            Set CreoModelItem = New CMpfcModelItem
        Dim ListTheseParameters As IpfcParameters
            Set ListTheseParameters = paramOwn.ListParams
       'First read the current rev from the drawing
'        Dim MedtrWindchillRev As IpfcParameter
'            Set MedtrWindchillRev = paramOwn.GetParam("PTC_WM_REVISION")
        Dim MedtrStatedRev As IpfcParameter
            Set MedtrStatedRev = paramOwn.GetParam("REVISION_LEVEL")
'------------------now create & set rmss parameters
        Dim ipRMSS_APPROVED As IpfcParameter
        Dim ipbRMSS_APPROVED As IpfcBaseParameter
        Dim pnRMSS_APPROVED As String
            pnRMSS_APPROVED = "RMSS_APPROVED"
        Dim RMSS_APPROVEDnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_APPROVED) Is Nothing Then
                Set RMSS_APPROVEDnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B13").Value)
                Set ipbRMSS_APPROVED = paramOwn.CreateParam(pnRMSS_APPROVED, RMSS_APPROVEDnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_APPROVED = paramOwn.GetParam(pnRMSS_APPROVED)
                Set RMSS_APPROVEDnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B13").Value)
                    ipRMSS_APPROVED.SetScaledValue RMSS_APPROVEDnv, Nothing
            End If

        Dim ipRMSS_APPROVE_DATE As IpfcParameter
        Dim ipbRMSS_APPROVE_DATE As IpfcBaseParameter
        Dim pnRMSS_APPROVE_DATE As String
            pnRMSS_APPROVE_DATE = "RMSS_APPROVE_DATE"
        Dim RMSS_APPROVE_DATEnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_APPROVE_DATE) Is Nothing Then
                Set RMSS_APPROVE_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B14").Value)
                Set ipbRMSS_APPROVE_DATE = paramOwn.CreateParam(pnRMSS_APPROVE_DATE, RMSS_APPROVE_DATEnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_APPROVE_DATE = paramOwn.GetParam(pnRMSS_APPROVE_DATE)
                Set RMSS_APPROVE_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B14").Value)
                    ipRMSS_APPROVE_DATE.SetScaledValue RMSS_APPROVE_DATEnv, Nothing
            End If

'        Dim ipRMSS_CUSTOMER_REV As IpfcParameter
'        Dim ipbRMSS_CUSTOMER_REV As IpfcBaseParameter
'        Dim pnRMSS_CUSTOMER_REV As String
'            pnRMSS_CUSTOMER_REV = "RMSS_CUSTOMER_REV"
'        Dim RMSS_CUSTOMER_REVnv As IpfcParamValue
'            If paramOwn.GetParam(pnRMSS_CUSTOMER_REV) Is Nothing Then
'                Set RMSS_CUSTOMER_REVnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B9").Value)
'                Set ipbRMSS_CUSTOMER_REV = paramOwn.CreateParam(pnRMSS_CUSTOMER_REV, RMSS_CUSTOMER_REVnv)
'                Set ListTheseParameters = paramOwn.ListParams
'            End If
           
        Dim ipRMSS_DRAWN_BY As IpfcParameter
        Dim ipbRMSS_DRAWN_BY As IpfcBaseParameter
        Dim pnRMSS_DRAWN_BY As String
            pnRMSS_DRAWN_BY = "RMSS_DRAWN_BY"
        Dim RMSS_DRAWN_BYnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_DRAWN_BY) Is Nothing Then
                Set RMSS_DRAWN_BYnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B15").Value)
                Set ipbRMSS_DRAWN_BY = paramOwn.CreateParam(pnRMSS_DRAWN_BY, RMSS_DRAWN_BYnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_DRAWN_BY = paramOwn.GetParam(pnRMSS_DRAWN_BY)
                Set RMSS_DRAWN_BYnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B15").Value)
                    ipRMSS_DRAWN_BY.SetScaledValue RMSS_DRAWN_BYnv, Nothing
            End If

        Dim ipRMSS_DRAWN_DATE As IpfcParameter
        Dim ipbRMSS_DRAWN_DATE As IpfcBaseParameter
        Dim pnRMSS_DRAWN_DATE As String
            pnRMSS_DRAWN_DATE = "RMSS_DRAWN_DATE"
        Dim RMSS_DRAWN_DATEnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_DRAWN_DATE) Is Nothing Then
                Set RMSS_DRAWN_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B16").Value)
                Set ipbRMSS_DRAWN_DATE = paramOwn.CreateParam(pnRMSS_DRAWN_DATE, RMSS_DRAWN_DATEnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_DRAWN_DATE = paramOwn.GetParam(pnRMSS_DRAWN_DATE)
                Set RMSS_DRAWN_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B16").Value)
                    ipRMSS_DRAWN_DATE.SetScaledValue RMSS_DRAWN_DATEnv, Nothing
            End If

        Dim ipRMSS_ECO_NUM As IpfcParameter
        Dim ipbRMSS_ECO_NUM As IpfcBaseParameter
        Dim pnRMSS_ECO_NUM As String
            pnRMSS_ECO_NUM = "RMSS_ECO_NUM"
        Dim RMSS_ECO_NUMnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_ECO_NUM) Is Nothing Then
                Set RMSS_ECO_NUMnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B18").Value)
                Set ipbRMSS_ECO_NUM = paramOwn.CreateParam(pnRMSS_ECO_NUM, RMSS_ECO_NUMnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_ECO_NUM = paramOwn.GetParam(pnRMSS_ECO_NUM)
                Set RMSS_ECO_NUMnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B18").Value)
                    ipRMSS_ECO_NUM.SetScaledValue RMSS_ECO_NUMnv, Nothing
            End If
           
        Dim ipRMSS_ECO_DATE As IpfcParameter
        Dim ipbRMSS_ECO_DATE As IpfcBaseParameter
        Dim pnRMSS_ECO_DATE As String
            pnRMSS_ECO_DATE = "RMSS_ECO_DATE"
        Dim RMSS_ECO_DATEnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_ECO_DATE) Is Nothing Then
                Set RMSS_ECO_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B19").Value)
                Set ipbRMSS_ECO_DATE = paramOwn.CreateParam(pnRMSS_ECO_DATE, RMSS_ECO_DATEnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_ECO_DATE = paramOwn.GetParam(pnRMSS_ECO_DATE)
                Set RMSS_ECO_DATEnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B19").Value)
                    ipRMSS_ECO_DATE.SetScaledValue RMSS_ECO_DATEnv, Nothing
            End If
           
        Dim ipRMSS_ECO_ENGR As IpfcParameter
        Dim ipbRMSS_ECO_ENGR As IpfcBaseParameter
        Dim pnRMSS_ECO_ENGR As String
            pnRMSS_ECO_ENGR = "RMSS_ECO_ENGR"
        Dim RMSS_ECO_ENGRnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_ECO_ENGR) Is Nothing Then
                Set RMSS_ECO_ENGRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B20").Value)
                Set ipbRMSS_ECO_ENGR = paramOwn.CreateParam(pnRMSS_ECO_ENGR, RMSS_ECO_ENGRnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_ECO_ENGR = paramOwn.GetParam(pnRMSS_ECO_ENGR)
                Set RMSS_ECO_ENGRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B20").Value)
                    ipRMSS_ECO_ENGR.SetScaledValue RMSS_ECO_ENGRnv, Nothing
            End If

'        Dim ipRMSS_PART_NUM As IpfcParameter
'        Dim ipbRMSS_PART_NUM As IpfcBaseParameter
'        Dim pnRMSS_PART_NUM As String
'            pnRMSS_PART_NUM = "RMSS_PART_NUM"
'        Dim RMSS_PART_NUMnv As IpfcParamValue
'            If paramOwn.GetParam(pnRMSS_PART_NUM) Is Nothing Then
'                Set RMSS_PART_NUMnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B11").Value)
'                Set ipbRMSS_PART_NUM = paramOwn.CreateParam(pnRMSS_PART_NUM, RMSS_PART_NUMnv)
'                Set ListTheseParameters = paramOwn.ListParams
'            End If

        Dim ipRMSS_REV As IpfcParameter
        Dim ipbRMSS_REV As IpfcBaseParameter
        Dim pnRMSS_REV As String
            pnRMSS_REV = "RMSS_REV"
        Dim RMSS_REVnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_REV) Is Nothing Then
                Set RMSS_REVnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B21").Value)
                Set ipbRMSS_REV = paramOwn.CreateParam(pnRMSS_REV, RMSS_REVnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_REV = paramOwn.GetParam(pnRMSS_REV)
                Set RMSS_REVnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B21").Value)
                    ipRMSS_REV.SetScaledValue RMSS_REVnv, Nothing
            End If
       
        Dim ipRMSS_REV_DESCR As IpfcParameter
        Dim ipbRMSS_REV_DESCR As IpfcBaseParameter
        Dim pnRMSS_REV_DESCR As String
            pnRMSS_REV_DESCR = "RMSS_REV_DESCR"
        Dim RMSS_REV_DESCRnv As IpfcParamValue
            If paramOwn.GetParam(pnRMSS_REV_DESCR) Is Nothing Then
                Set RMSS_REV_DESCRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B22").Value)
                Set ipbRMSS_REV_DESCR = paramOwn.CreateParam(pnRMSS_REV_DESCR, RMSS_REV_DESCRnv)
                Set ListTheseParameters = paramOwn.ListParams
            Else
                Set ipRMSS_REV_DESCR = paramOwn.GetParam(pnRMSS_REV_DESCR)
                Set RMSS_REV_DESCRnv = CreoModelItem.CreateStringParamValue(sheets("Parameters").range("B22").Value)
                    ipRMSS_REV_DESCR.SetScaledValue RMSS_REV_DESCRnv, Nothing
            End If
           
        sheetOwner.CurrentSheetNumber = 1
        sheetOwner.RegenerateSheet (1)
       
                 'Now delete & replace sheet formats from each sheet
         For sheetStep = 1 To totalSheets
                Dim modelDesc As CCpfcModelDescriptor
                Set modelDesc = New CCpfcModelDescriptor
                Dim formatMdlDesc As IpfcModelDescriptor
                    Set formatMdlDesc = modelDesc.CreateFromFileName("rmss-medtronic-11x17-pg1andpg2.frm")
                Dim formatMdl As IpfcDrawingFormat
                    Set formatMdl = CreoSession.RetrieveModel(formatMdlDesc)
                If sheetStep = 1 Then
                    sheetOwner.SetSheetFormat 1, formatMdl, 1, CreoSession.CurrentModel
                Else
                    sheetOwner.SetSheetFormat sheetStep, formatMdl, 2, CreoSession.CurrentModel
                End If
         Next sheetStep
         sheetStep = 0
       
        sheetOwner.CurrentSheetNumber = 1
        sheetOwner.RegenerateSheet (1)
        
       

 

1 reply

R
RandyJones20-Turquoise
20-Turquoise
March 12, 2018

                If (CurTABLE.CheckIfIsFromFormat(sheetStep) = True And CurTABLE.GetSegmentSheet(0) = sheetStep) Then
               
                   'Set tableToDelete = CurTABLE
                    'tabletodelete.DeleteTable(CurTABLE, False) <-------------------------------------Cannot get this to work

You need to delete the table from the drawing. The table object (at least in jlink and weblink) does not have a delete method. ie

CreoDRW .DeleteTable(CurTABLE, False)

J
JanKirsten1-VisitorAuthor
1-Visitor
March 12, 2018

Hi Randy,

 

Thanks for the rely. Been looking at this all day now. Can't seem to find a way to relate the Drawing to the Active model.

 

Tried

Dim thisDrawing As CpfcDrawing

.

.

Set thisDrawing = CreoSession.GetActiveModel

 

but gives a type mismatch

 

Do you know if I have to do it by Id maybe? As you probably suspect I am not very well versed in Creo VB API, it is a lot different from the Solidworks macros and Excel VBA

Will keep on digging.

 

Thanks

 

Jan

 

 

 

 

 

R
RandyJones20-Turquoise
20-Turquoise
March 12, 2018

I have never used vba. Instead either jlink or weblink. In jlink to have a drawing you would type the Model to a Drawing eg:

Session session = pfcGlobal.GetProESession();
Model currentModel = session.GetCurrentModel();//returns a Model
Drawing drawing = (Drawing)currentModel;//type the Model to a Drawing
Terms & ConditionsAccessibility statement