新建文件宏程序：新建零件、装配体、工程图、插入零件到装配体等命令自动运行

目录

1.程序运行效果

2.插入新建文件宏到SolidWorks

3.程序代码

---

1.程序运行效果

2.插入新建文件宏到SolidWorks

 

3.程序代码

'新建零件、装配体、工程图
Private Sub cmdNewModel_Click()
  Dim swApp As SldWorks.SldWorks
  Set swApp = Application.SldWorks
  Dim swModel As SldWorks.ModelDoc
  'Find the selected option and connect to theModelDoc2 object
   If 零件.Value = True Then
  Set swModel = swApp.NewDocument("D:\UT规范\UT模板\模板\UT模型模板\零件.prtdot", 0, 0#, 0#) '新建零件，零件模板路径，在SW设置-文件模板可知
End If
If 装配体.Value = True Then
  Set swModel = swApp.NewDocument("D:\UT规范\UT模板\模板\UT模型模板\装配体.asmdot", 0, 0#, 0#)  '新建装配体，装配体模板路径，在SW设置-文件模板可知
End If
If 工程图.Value = True Then
   Set swModel = swApp.NewDocument("D:\UT规范\UT模板\模板\工程图模板\零件工程图A3.drwdot", 0, 0#, 0#)  '新建工程图，工程图模板路径，在SW设置-文件模板可知
End If

' Determine which items are checked
' and call specific methods and properties onModelDoc2
If 新建草图.Value = True Then
  If 工程图.Value = True Then
  Else
    swModel.SketchManager.InsertSketch True '新建草图
  End If
End If

If 插入设计表.Value = True Then
  If 工程图.Value = True Then
  Else
    swModel.InsertFamilyTableNew '插入设计表
    
  End If
End If
If 插入注释.Value = True Then
  Dim swNote As SldWorks.Note
  Dim swAnnotation As SldWorks.Annotation
  Dim text As String
  text = "Sample Note" '注释内容，可自定义
  Set swNote = swModel.InsertNote(text) '插入注释
  Set swAnnotation = swNote.GetAnnotation
  swAnnotation.SetPosition 0, 0, 0 '注释坐标，可自定义输入坐标位置
End If
End Sub

'零件文档

Private Sub 新零件_Click()
Dim swApp As SldWorks.SldWorks
  Set swApp = Application.SldWorks
  Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.NewDocument("D:\UT规范\UT模板\模板\UT模型模板\零件.prtdot", 0, 0#, 0#) '新建零件，零件模板路径，在SW设置-文件模板可知
  Dim swPart As SldWorks.PartDoc
  Set swPart = swModel
  swModel.SketchManager.InsertSketch True
  swModel.SketchManager.CreateCornerRectangle 0, 0, 0, 0.1, 0.1, 0 '创建草图方形，长0.1m，宽0.1mm
  swModel.FeatureManager.FeatureExtrusion2 True, False, False, 0, 0, 0.1, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, 1, 1, 1, 0, 0, False
    '创建特征，深度0.1m
    If 回退.Value = True Then
  swPart.EditRollback '特征回退
End If
End Sub

'装配体文档
Private Sub 新装配体_Click()
Dim swApp As SldWorks.SldWorks
  Set swApp = Application.SldWorks
  Dim fileerror As Long
  Dim filewarning As Long
  swApp.OpenDoc6 "D:\11111\YF001-03-304.SLDPRT", swDocPART, swOpenDocOptions_Silent, "", fileerror, filewarning '打开YF001-03-304零件，拿自己本地文件测试，路径换成自己的文件路径
  Dim swModel As SldWorks.ModelDoc2
  Set swModel = swApp.NewDocument("D:\UT规范\UT模板\模板\UT模型模板\装配体.asmdot", 0, 0#, 0#) '新建装配体，装配体模板路径，在设置-文件模板可知

Dim swAssy As SldWorks.AssemblyDoc
  Set swAssy = swModel
If 插入零件.Value = True Then
  swAssy.AddComponent5 "D:\11111\YF001-03-304.SLDPRT", swAddComponentConfigOptions_CurrentSelectedConfig, "", False, "", 0, 0, 0 '插入打开的零件YF001-03-304
End If
End Sub

'工程图文档
Private Sub 新工程图_Click()

Dim swApp As SldWorks.SldWorks
  Set swApp = Application.SldWorks
  Dim swDraw As SldWorks.DrawingDoc
  Set swDraw = swApp.NewDocument("D:\UT规范\UT模板\模板\工程图模板\零件工程图A3.drwdot", 0, 0#, 0#) '新建工程图，工程图模板路径，在设置-文件模板可知

If 编辑图纸格式.Value = True Then
  'Notice the automatic type casting
  'Visual Basic does for you
  swDraw.EditTemplate
        End If
     
End Sub