在网上看到的：在WIN7 SW2014下现在不能用，看看改了能用不烦请懂的人指点下，并将文件上传到里来：
SolidWorks 生成工程图纸程序
下面代码是工程图助手中的“生成工程图”模块内容。它按照我们的图纸存储规范，把一个产品的每个装配体都生成一个solidworks的工程图文件。
面对一个问题，我们在试图使用VBA来改善工作的时候，可以参考下面的思路来进行，当然，这也只是个人的一些经验之说，并不是最好的工作方式：
首先我们需要了解实际工作情况，发现问题所在：工艺人员在试图提高solidworks工作效率的时候提到了使用SolidWorks Task Scheduler来自动出图纸的方法（具体方法就不讨论了）。大家经过一段时间的使用后发现，使用SolidWorks Task Scheduler有一定的局限性，需要问题在于，它将每个solidworks文件—包括零件、装配体—都生成了一个工程图文件。然而这样得到的结果便是一个零部件稍多的产品，将会自动生成很多的工程图文件，不便于管理。我们的习惯是，按照装配体来出图纸，将一个装配体中的零部件在一个工程图文件中表示。这样表达清楚而且便于管理。恩，这就是现实的问题所在。
然后，我们要考虑可行性：思考了SolidWorks Task Scheduler的实现，发现使用VBA在技术方面可以实现此类功能，并且有一定的规律可以遵守而不需要太多的人为判断就可以达到要求。这里插一句，在使用SolidWorks Task Scheduler时我发现了一个选项：备份任务文件，而这个任务文件上所记录的正式一段使用VBA写的宏代码。
接下来，需要现场调研确定需求目标：在了解了solidworks使用相应的规范和工艺员在实际工作中的要求后我们对问题目标有了一个比较明确的概念。我们要做的项目需要完成这样的工作：它针对一个产品中的每个装配体生成一个工作图文件，每本工程图文件中需要一张装配体的三视图和其每个子零件的三视图图纸。并将它们存储在和“图纸”文件夹（存放solidworks模型）同级的目录下的“工程图”文件夹里。
做好了准备工作，即可开始写程序。将需求的内容转化成软件问题描述，并描述其大致方法：
1、得到产品文件的每个装配体：我们可以通过文件夹中文件的遍历，按照后缀名“.sldasm”来得到一个目录下所有的装配体；也可以通过遍历一个产品总装配体的组件来得到每一个子装配体模型。实际的编码中我们选择了后者，因为它虽然给编写代码结构带
来了复杂度，但是正确性和稳定性都要好过前者。装配体的组件是一个树型结构，使用递归式是比较灵活的方法，前面章节也已经介绍过。
2、生成工程图并插入零件的模型三视图：SolidWorks Task Scheduler使用预定义的模型视图来完成自动生成的功能，但是，一旦需要在原有的图纸上插入新图纸时，就不能够继承图纸模版的预定义试图了。所以需要使用resultset 遍历CreateDrawViewFromModelView2和CreateUnfoldedViewAt3来替代。
一切准备完毕后就可以设计程序框架进行编码了：这里定义了三个过程，main、traverseasm、createdraw。它们的定义和完成的作用如下：
Main（）：模块主函数没有参数和返回值，它得到当前打开装配体的路径、设置“工程图文件夹路径”、运行traverseasm过程。
Traverseasm(filepath as string):此过程接受一个装配体的存储路径字符串参数，完成装配体的递归遍历工作，得到每一个装配体，并让每一个装配体都作为参数运行createdraw过程。
Createdraw(filepath as string): 此过程接受一个装配体的存储路径字符串参数，生成此装配体的工程图。
'/************************************************************
'drawcreator ： 根据装配体生成工程图
'main:
' get opened asm model infomation:
' filepathname
' drawpathname
' make dir path is drawpathname
' call traverseasm with argument filepathname'
'traverseasm:
' for itself call createdraw with argument itself
' traverse the asm model component
' for each sub asm model:
' call traverseasm'
'createdraw:
' create a drawdoc with given DrawTemplate
' insert each sub part model component a sheet
'
'************************************************************/
Option Explicit
'定义部分：
Dim SwApp As
Dim DrawPathName As String
Dim File As String
Dim nErrors As Long
Dim nWarnings As Long
Dim StatofanNo As Boolean
Dim Pos As Integer
'/******************
'sub main goes here:
'*******************
Sub Main()
On Error Resume Next
Dim ActModel As
Dim YesOrNo As VbMsgBoxResult
Set SwApp = CreateObject("")
Set ActModel =
If ActModel Is Nothing Then
MsgBox "请先打开装配体"
End If
'得到装配体文件路径
File =
'得到工程图保存路径
DrawPathName = Left(File, InStrRev(File, "\") - 1)
DrawPathName = Left(DrawPathName, InStrRev(DrawPathName, "\"))
DrawPathName = DrawPathName + "工程图\"
'创建文件夹
MkDir (DrawPathName)
'调试信息 :
DrawPathName
File
'should i set all object nothing
Set ActModel = Nothing
Set SwApp = Nothing
YesOrNo = MsgBox("需要自动在零件工程图中插入模型项目么", vbOKCancel, "提示")
If YesOrNo = vbOK Then
StatofanNo = True
Else
StatofanNo = False
End If
= False
'调用函数遍历装配体组件
TraverseAsm File
= True
End Sub
'/************************
'sub traverseasm goes here :
''*************************
Sub TraverseAsm(FilePath As String) 'Traverse Asm 遍历ASM文件
Dim SwModel2 As
Dim SwConf2 As
Dim SwRootComp2 As
Dim SwChildComp2 As
Dim vChildComp2 As Variant
Dim FileType2 As String
Dim n As Long
Set SwApp = CreateObject("")
If SwApp Is Nothing Then
MsgBox "创建SW对象失败"
Exit Sub
End If
Set SwModel2 = (FilePath, 2, 0, "", nErrors, nWarnings) 'file open good
If SwModel2 Is Nothing Then
MsgBox "加载装配体失败"
Exit Sub
End If
Set SwConf2 = 'need to change SwModel to traverse
Set SwRootComp2 =
vChildComp2 =
For n = 0 To UBound(vChildComp2)
Set SwChildComp2 = vChildComp2(n)
FileType2 = UCase(Right, 6))
If FileType2 = "SLDASM" Then
TraverseAsm
End If
Next
If Not Mid, 1, 2) = "镜向" Then
CreateDraw
End If
End Sub
'/**************************************************
'sub createdraw goes here :
'**************************************************/
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论