Batch Convert DRW Files in a Colder to DWG

□ Program Development Sequence (Creo 9.0)

       1. Get all DRW file names in working folder
       2. Save DRW file as DWG file
       3. Display file conversion progress results

TOOLBOX_VBA0001.xlsm

0.04MB

 

□ Program Screen

 

 

---

▷About Exporting Drawings to DXF or DWG Files

PTC Help Center

 

• The VBA API does not provide a DWG conversion function.
• Create a MAPKEY and use the program to call it from VBA.
• DRW conversion preferences are set in the Config.pro file.

▷ MAPKey Construction

1. Mouse Click Order

Note: Click 4 in the following order. VBA recognizes the second type.
PVZ => DWG

2. Mapkey

 . Select DWG type

mapkey DWGE01 ~ Close `main_dlg_cur` `appl_casc`;~ Command `ProCmdModelSaveAs` ;\"
mapkey(continued) ~ Open `file_saveas` `type_option`;~ Close `file_saveas` `type_option`;\"
mapkey(continued) ~ Select `file_saveas` `type_option` 1 `db_1102`;\"
mapkey(continued) ~ Open `file_saveas` `type_option`;~ Close `file_saveas` `type_option`;\"
mapkey(continued) ~ Select `file_saveas` `type_option` 1 `db_560`;\

. DWG conversion

mapkey DWGE02~ Activate `file_saveas` `OK`;\"
mapkey(continued) ~ Activate `export_2d_dlg` `Export_Button`;\"
mapkey(continued) ~ Activate `UI Message Dialog` `ok`;\"
mapkey(continued) ~ Activate `export_2d_dlg` `Cancel_Button`;

. Close Window

mapkey WINCL @MAPKEY_NAMEWINCL;@MAPKEY_LABELWINCL;\"
mapkey(continued) ~ Activate `main_dlg_cur` `page_View_control_btn` 1;\"
mapkey(continued) ~ Command `ProCmdWinCloseGroup`;

 

---

 1. Get All DRW File Names In Working Folder

Option Explicit
Sub FolderPartList02()
    On Error GoTo RunError
    Application.EnableEvents = False

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
    Dim stringseq As Istringseq
    Set stringseq = BaseSession.ListFiles("*.drw", 1, "")
    
    Dim i As Integer
    
    Dim fullPath As String
    Dim fileName As String
    Dim lastBackslash As Integer
    Dim fileVersionSeparator As Integer
        
    For i = 0 To stringseq.Count - 1
    
        Worksheets("DrwConvert").Cells(i + 6, "A") = i + 1
        fullPath = stringseq(i)
        lastBackslash = InStrRev(fullPath, "\")
        fileName = Mid(fullPath, lastBackslash + 1)
        fileVersionSeparator = InStrRev(fileName, ".")
        fileName = Left(fileName, fileVersionSeparator - 1)
        Worksheets("DrwConvert").Cells(i + 6, "B") = fileName
    
    Next i
    
    MsgBox "I brought all the Drawing names.", vbInformation, "korealionkk@gmail.com"
    
    conn.Disconnect (2)
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
RunError:
            If Err.Number <> 0 Then
                MsgBox "Process Failed: An error occurred." & vbCrLf & _
                       "Error No: " & CStr(Err.Number) & vbCrLf & _
                       "Error Description: " & Err.Description & vbCrLf & _
                       "Error Source: " & Err.Source, vbCritical, "Error"
                If Not conn Is Nothing Then
                    If conn.IsRunning Then
                        conn.Disconnect (2)
                    End If
                End If
            End If
End Sub

 

▷ Istringseq interface represents a sequence of strings.

▷ "Get Name" Run the program 

---

 2. Save DRW File as DWG File

• The dwg file is saved in the working folder.
• There is no code to change the save location

Sub DwgConvert()

    On Error GoTo RunError
    Application.EnableEvents = False

    '// Module Name : CreoVBAStart
    Call CreoVBAStart.CreoConnt01
    
     Dim CreateModelDescriptor As New CCpfcModelDescriptor
     Dim ModelDescriptor As IpfcModelDescriptor
     Dim Window As IpfcWindow
     Dim CellFileName As String
     Dim rng As Range
     Dim i As Integer
     Set rng = Worksheets("DrwConvert").Range("B6", Cells(Rows.Count, "B").End(xlUp))
         
     Dim vbamacro01 As String
     Dim vbamacro02 As String
     Dim vbamacro03 As String

    vbamacro01 = "mapkey DWGE01 ~ Close `main_dlg_cur` `appl_casc`;~ Command `ProCmdModelSaveAs` ;\" _
                        & "mapkey(continued) ~ Open `file_saveas` `type_option`;~ Close `file_saveas` `type_option`;\" _
                        & "mapkey(continued) ~ Select `file_saveas` `type_option` 1 `db_1102`;\" _
                        & "mapkey(continued) ~ Open `file_saveas` `type_option`;~ Close `file_saveas` `type_option`;\" _
                        & "mapkey(continued) ~ Select `file_saveas` `type_option` 1 `db_560`;\"
                        
     vbamacro02 = "mapkey DWGE02~ Activate `file_saveas` `OK`;\" _
                            & "mapkey(continued) ~ Activate `export_2d_dlg` `Export_Button`;\" _
                            & "mapkey(continued) ~ Activate `UI Message Dialog` `ok`;\" _
                            & "mapkey(continued) ~ Activate `export_2d_dlg` `Cancel_Button`;"

                        
     vbamacro03 = "mapkey WINCL @MAPKEY_NAMEWINCL;@MAPKEY_LABELWINCL;\" _
                        & "mapkey(continued) ~ Activate `main_dlg_cur` `page_View_control_btn` 1;\" _
                        & "mapkey(continued) ~ Command `ProCmdWinCloseGroup`;"
                        
                        
     For i = 0 To rng.Count - 1
     
          CellFileName = Worksheets("DrwConvert").Cells(i + 6, "B")
          Set ModelDescriptor = CreateModelDescriptor.CreateFromFileName(CellFileName)
          Set model = BaseSession.RetrieveModel(ModelDescriptor) '// Importing a model into a Session
          model.Display '// Activate the model
          Set Window = BaseSession.GetModelWindow(model)
          'model.Display '// Activate the model
          Window.Activate  '// Activate the new window before DWG
         
          BaseSession.RunMacro (vbamacro01)
          BaseSession.RunMacro (vbamacro02)
          
          '// Application.Wait Now + TimeValue("0:00:05") '//Wait for 5 seconds

          BaseSession.RunMacro (vbamacro03)
          Worksheets("DrwConvert").Cells(i + 6, "C") = "OK"
         
     Next i
    
    
    
    MsgBox "DWG conversion completed.", vbInformation, "korealionkk@gmail.com"
    
    conn.Disconnect (2)
    
    
    '// Cleanup
    Set asynconn = Nothing
    Set conn = Nothing
    Set BaseSession = Nothing
    Set model = Nothing
    
RunError:
            If Err.Number <> 0 Then
                MsgBox "Process Failed: An error occurred." & vbCrLf & _
                       "Error No: " & CStr(Err.Number) & vbCrLf & _
                       "Error Description: " & Err.Description & vbCrLf & _
                       "Error Source: " & Err.Source, vbCritical, "Error"
                If Not conn Is Nothing Then
                    If conn.IsRunning Then
                        conn.Disconnect (2)
                    End If
                End If
            End If
End Sub

□ Program Screen

 

dwgcoverter.cls

0.01MB

CreoVBAStart.bas

0.00MB

 

You can call mapkey in creo vba. There are some unknown errors, but you can solve them by trying various methods.

^_^