文章

VB 操作 CAD

发表于
作者 sharpcj
2 分钟阅读
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

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
技术, 编程, VB
VB CAD
文章可转载，转载请务必注明出处。