VB操作CAD

Dim xlapp As Excel.Application
            Dim xlbook As Excel.Workbook
            Dim sheet As Excel.Worksheet

            Dim Range As Excel.Range

        Dim zwcadapp As ZwcadApplication
       
        Dim obj As Excel.OLEObject
       
       
       
        Set xlapp = New Excel.Application
'        Set xlbook = xlapp.Workbooks.Add
'        Set xlapp = New Excel.Application
'        Set xlapp = CreateObject("Excel.Application")
        Set xlbook = xlapp.Workbooks.Add
        Set xlsheet = xlbook.Worksheets.Add
        xlapp.Visible = True

        xlsheet.Cells(1, 1) = "测试" '写入内容

        Set Range = xlsheet.Range("B2")

       
       
        Range.Select
        Set obj = xlsheet.OLEObjects.Add(FileName:="E:\Data\Eg\PROGRAM\MiTOP\BOTSmt.dwg", Link:=True, DisplayAsIcon:=False)
        obj.Verb Verb:=xlPrimary

        On Error Resume Next
        Set zwcadapp = GetObject(, "ZwCAD.Application")
        If Err Then
            MsgBox ("CAD启动错误")
            Exit Sub
        End If
        zwcadapp.Visible = False

        zwcadapp.WindowState = acMax
        zwcadapp.ZoomExtents   '可以显示图形的全部，使绘制的图形最大限度地充满绘图区域

        zwcadapp.ActiveDocument.Save
        zwcadapp.ActiveDocument.Close

        zwcadapp.Quit
        Set zwcadapp = Nothing

Dim zwcadapp As ZwcadApplication
       
        Dim obj As Excel.OLEObject
       
        range.Select
        Set obj = objsheet.OLEObjects.add(FileName:=strFileName, Link:=True, DisplayAsIcon:=False)
        obj.Verb Verb:=xlPrimary
       
        On Error Resume Next
        Set zwcadapp = GetObject(, "ZwCAD.Application")
        If Err Then
            MsgBox ("CAD启动错误")
            Exit Sub
        End If
        zwcadapp.Visible = False
   
        zwcadapp.WindowState = zcMax
        zwcadapp.ZoomExtents   '可以显示图形的全部，使绘制的图形最大限度地充满绘图区域
       
       
        zwcadapp.ActiveDocument.SetVariable ("filedia"), 0                '''''''''''''''''''''''''禁止弹出对话框
       
        zwcadapp.ActiveDocument.Save
        zwcadapp.ActiveDocument.Close
       
        zwcadapp.Quit
        Set zwcadapp = Nothing
          
          
        With obj.ShapeRange
            .Fill.Visible = msoTrue
            .Fill.Solid
            .Fill.ForeColor.SchemeColor = 65
            .Fill.Transparency = 1#                '透明度100%
            .Line.Weight = 0.75
            .Line.DashStyle = msoLineSolid
            .Line.Style = msoLineSingle
            .Line.Transparency = 0#
            .Line.Visible = msoFalse
        End With
       
        If isSMT = True And isPagesizeA3 = True Then
            With obj.ShapeRange
                .IncrementTop 25#
            End With
        End If

        If isSMT = True And isPagesizeA3 = False Then
            With obj.ShapeRange
                .LockAspectRatio = msoTrue
                .width = 570#
                .IncrementTop 100.25
            End With
        End If
       
        If isSMT = False And isPagesizeA3 = True Then
            With obj.ShapeRange
                .LockAspectRatio = msoTrue
                .width = 588#
                .IncrementLeft 229#
            End With
        End If
       
        If isSMT = False And isPagesizeA3 = False Then
            With obj.ShapeRange
                .LockAspectRatio = msoTrue
                .width = 570#
                .IncrementLeft 143#
            End With
        End If