frmimport.frm

VB开发环境下如何将CAD2004转换为CAD2000版本的数据。

VERSION 5.00
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.0#0"; "SuperMap.ocx"
Begin VB.Form frmImport 
   Caption         =   "2004CAD数据导入测试"
   ClientHeight    =   1155
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   3645
   LinkTopic       =   "Form1"
   ScaleHeight     =   1155
   ScaleWidth      =   3645
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "导入2004CAD格式数据测试"
      Height          =   855
      Left            =   75
      TabIndex        =   0
      Top             =   105
      Width           =   3480
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   375
      Top             =   675
      _Version        =   327680
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmImport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    '示范将一个2004版本格式的数据导入到SuperMap中
    '处理过程
    '1,获得文件版本
    '2,判断版本，如果是R2004，将此文件转换为2000的DXF文件
    '  本示范中将DWG文件处理为2000Tmp.dxf
    '3,如果转换成功，导入转换后的dxf 数据。
    Dim objDs As soDataSource
    Dim objDpmp As soDataPump
    Dim objImpParam As soImportParams
    Dim strFileName As String
    Dim strTmp As String
    Dim bRst As Boolean
    SuperWorkspace1.Datasources.RemoveAll
    Set objDs = SuperWorkspace1.CreateDataSource(App.Path & "\test.sdb", "test", sceSDBPlus, False, False, False, "")
    If Not objDs Is Nothing Then
        
        strFileName = App.Path & "\data\2004.dwg"
        MakeGetVerBat strFileName
        Shell App.Path & "\Ver.bat", vbHide
        strTmp = GetVer
        If Trim(strTmp) = "R2004" Then
            Convert2004to2000Bat strFileName
            Shell App.Path & "\Convert.bat", vbHide
            If IfSuccess Then
                strFileName = App.Path & "\2000Tmp.dxf"
            End If
        End If
        Dim objEr As New soError
        Set objDpmp = objDs.DataPump
        Set objImpParam = objDpmp.DataImportParams
        With objImpParam
            .DatasetCAD = "MyCAD"
            .FileName = strFileName
            .FileType = scfDXF
            .ImportAsCADDataset = True
        End With
        bRst = objDpmp.Import
        If bRst Then
            MsgBox "导入数据成功", vbInformation, "信息提示"
        Else
            MsgBox "导入数据失败。" & vbCrLf & objEr.LastErrorMsg, vbInformation, "信息提示"
        End If
    Else
        MsgBox "创建数据源失败。", vbInformation, "信息提示"
    End If
End Sub


Private Sub MakeGetVerBat(strFileName As String)
    '制作相关获得版本信息的批处理文件
    Dim nfile As Integer
    nfile = FreeFile
    Open App.Path & "\" & "Ver.bat" For Output Access Write As #nfile
    Print #nfile, App.Path & "\AcadConvertor.exe " & strFileName & " >" & App.Path & "\Ver.txt"
    Close #nfile
End Sub

Private Function GetVer() As String
    '获得分析出来的版本信息
    Dim objFielSys As New FileSystemObject
    Dim objFileRead As File
    Dim objTextStream As TextStream
    Dim str As String
    Dim strFileName  As String
    GetVer = ""
    strFileName = App.Path & "\Ver.txt"
    Set objFileRead = objFielSys.GetFile(strFileName)
    If objFileRead Is Nothing Then Exit Function
    
    Set objTextStream = objFileRead.OpenAsTextStream(ForReading)
    If objTextStream Is Nothing Then Exit Function
    str = objTextStream.ReadLine
    GetVer = str
    
    Set objTextStream = Nothing
    Set objFielSys = Nothing
    Set objFielSys = Nothing
End Function

Private Function IfSuccess() As Boolean
    '获取是否转换成功
    Dim objFielSys As New FileSystemObject
    Dim objFileRead As File
    Dim objTextStream As TextStream
    Dim str As String
    Dim strFileName  As String
    
    IfSuccess = False
    strFileName = App.Path & "\Convert.txt"
    Set objFileRead = objFielSys.GetFile(strFileName)
    If objFileRead Is Nothing Then Exit Function
    
    Set objTextStream = objFileRead.OpenAsTextStream(ForReading)
    If objTextStream Is Nothing Then Exit Function
    str = objTextStream.ReadLine
    If Trim(str) = "Success" Then
        IfSuccess = True
    Else
        IfSuccess = False
    End If
    Set objFileRead = Nothing
    Set objTextStream = Nothing
    Set objFielSys = Nothing
    Set objFielSys = Nothing
End Function

Private Sub Convert2004to2000Bat(strFileName As String)
    '制作将2004个是转换为2000格式的BAT文件
    Dim nfile As Integer
    nfile = FreeFile
    Open App.Path & "\" & "Convert.bat" For Output Access Write As #nfile
    Print #nfile, App.Path & "\AcadConvertor.exe " & strFileName & " " & App.Path & "\2000Tmp.dxf  R2000" & " >" & App.Path & "\Convert.txt"
    Close #nfile
End Sub