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\ 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