学习目标

● 设计宏以实现自动创建工程图

● 基于具有多种配置的装配体创建含有多张图纸[1]的工程图

● 在工程图的每张图纸上插入工程图视图

● 自动插入模型注释和尺寸标注

● 以不同的文件格式自动保存工程图

6.1 实例学习：自动化工程图创建工具

自动创建工程图的宏用来展示与工程图创建相关的API调用。它可以自动创建工程图图纸，并按特定配置命名每张图纸。同时它还能导入模型尺寸标注和注释，如图6-1所示。

操作步骤

步骤1 打开现有的装配体并创建新的宏 打开装配体DrawingAuto-mation.sldasm，创建新的宏并命名为DrawingAutomation.swp。

6.1 实例学习：自动化工程图创建工具

步骤2 修改宏代码 早绑定到SldWorks并连接到活动模型。输入以下代码：

Const TRAININGDIR As String = _
  "C:\\SolidWorks Training Files\\API Fundamentals\\"
Const TEMPLATEDIR As String = _
  "C:\\SolidWorks Training Files\\Training Templates\\"
Const TEMPLATENAME As String = _
  TEMPLATEDIR & "Drawing_ANSI.drwdot"
Const SCALENUM As Double = 1#
Const SCALEDENOM As Double = 2#
Const SAVEASPATH As String = TRAININGDIR & "Export\\"

Dim errors As Long
Dim warnings As Long
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim Response As Integer
Dim ThirdAngle As Boolean
Dim swDraw As SldWorks.DrawingDoc
Dim ConfigNamesArray As Variant
Dim ConfigName As Variant
Dim i As Long
Dim retval As Boolean
Dim swView As SldWorks.View

Sub main()
  Response = MsgBox("Create third angle projection?", _
    vbYesNo)
  If Response = vbYes Then
    ThirdAngle = True
  Else
    ThirdAngle = False
  End If
  Set swApp = Application.SldWorks
  Set swModel = swApp.ActiveDoc
  Set swDraw = swApp.NewDocument(TEMPLATENAME, _
    swDwgPaperA1size, 0#, 0#)
  ConfigNamesArray = swModel.GetConfigurationNames
  For i = 0 To UBound(ConfigNamesArray)
    ConfigName = ConfigNamesArray(i)
    If i > 0 Then
      retval = swDraw.NewSheet4(ConfigName, swDwgPaperA1size, _
        swDwgTemplateA1size, SCALENUM, SCALEDENOM, _
        Not ThirdAngle, "", 0#, 0#, "", 0#, 0#, 0#, 0#, 0, 0)
    Else
      retval = swDraw.SetupSheet6(ConfigName, _
        swDwgPaperA1size, swDwgTemplateA1size, SCALENUM, _
        SCALEDENOM, Not ThirdAngle, "", 0#, 0#, "", False, 0#, _
        0#, 0#, 0#, 0, 0)
    End If
    If ThirdAngle = True Then
      retval = swDraw.Create3rdAngleViews2(swModel.GetPathName)
    Else
      retval = swDraw.Create1stAngleViews2(swModel.GetPathName)
    End If
    Set swView = swDraw.GetFirstView
    Do While Not swView Is Nothing
      swView.ReferencedConfiguration = ConfigName
      Set swView = swView.GetNextView
    Loop
    Dim RebuildSuccess As Boolean
    RebuildSuccess = swDraw.ForceRebuild3(True) 'ModelDoc2.ForceRebuild3
    swDraw.InsertModelAnnotations3 _
      swImportModelItemsFromEntireModel, _
      swInsertDimensionsMarkedForDrawing + _
      swInsertNotes, True, True, True, False
    swDraw.Extension.SaveAs SAVEASPATH & ConfigName & ".DXF", _
      swSaveAsCurrentVersion, swSaveAsOptions_Silent, _
      Nothing, errors, warnings
    swDraw.Extension.SaveAs SAVEASPATH & ConfigName & ".DWG", _
      swSaveAsCurrentVersion, swSaveAsOptions_Silent, _
      Nothing, errors, warnings
    swDraw.Extension.SaveAs SAVEASPATH & ConfigName & ".JPG", _
      swSaveAsCurrentVersion, swSaveAsOptions_Silent, _
      Nothing, errors, warnings
    swDraw.Extension.SaveAs SAVEASPATH & ConfigName & ".TIF", _
      swSaveAsCurrentVersion, swSaveAsOptions_Silent, _
      Nothing, errors, warnings
  Next i
End Sub

步骤3 提示用户投影类型 使用VBA内在的MsgBox函数提醒用户投影的类型。输入以下代码：

Response = MsgBox("Create third angle projection?", _
    vbYesNo)
  If Response = vbYes Then
    ThirdAngle = True
  Else
    ThirdAngle = False
  End If

步骤4 添加工程图模板和缩放常量 TEMPLATENAME的值传递给用于创建新工程图文件的方法。最后两个值用于在工程图上设置或创建新图纸。

步骤5 新建工程图 添加以下代码，新建工程图文件。

步骤6 保存并运行宏 成功新建工程图，如图6-2所示。结束后返回VBA。