《SolidWorks根据装配体生成工程图的宏程序.docx》由会员分享，可在线阅读，更多相关《SolidWorks根据装配体生成工程图的宏程序.docx（15页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、S o l i d W o r k s 依据装配体生成工程图的宏程序( 总 8 页)-CAL-FENGHAI.-(YICAI)-Company One1-CAL-本页仅作为文档封面，使用请直接删除在网上看到的：在 WIN7 SW2014 下现在不能用，看看改了能用不烦请懂的人教导下，并将文件上传到群里来：SolidWorks 生成工程图纸程序下面代码是工程图助手中的“生成工程图”模块内容。它依据我们的图纸存储标准，把一个产品的每个装配体都生成一个 solidworks 的工程图文件。面对一个问题，我们在试图使用 VBA 来改善工作的时候，可以参考下面的思路来进展，固然，这也只是个人的一些阅历之
2、说，并不是最好的工作方式：首先我们需要了解实际工作状况，觉察问题所在：工艺人员在试图提高solidworks 工作效率的时候提到了使用 SolidWorks Task Scheduler 来自动出图纸的方法具体方法就不争论了。大家经过一段时间的使用后觉察，使用SolidWorks Task Scheduler 有肯定的局限性，需要问题在于，它将每个solidworks 文件包括零件、装配体都生成了一个工程图文件。然而这样得到的结果便是一个零部件稍多的产品，将会自动生成很多的工程图文件，不便于治理。我们的习惯是，依据装配体来出图纸，将一个装配体中的零部件在一个工程图文件中表示。这样表达清楚而且便
3、于治理。恩，这就是现实的问题所在。然后，我们要考虑可行性：思考了 SolidWorks Task Scheduler 的实现，觉察使用 VBA 在技术方面可以实现此类功能，并且有肯定的规律可以遵守而不需要太多的人为推断就可以到达要求。这里插一句，在使用 SolidWorks Task Scheduler 时我觉察了一个选项：备份任务文件，而这个任务文件上所记录的正式一段使用 VBA 写的宏代码。10接下来，需要现场调研确定需求目标：在了解了 solidworks 使用相应的标准和工艺员在实际工作中的要求后我们对问题目标有了一个比较明确的概 念。我们要做的工程需要完成这样的工作：它针对一个产品中
4、的每个装配体生成一个工作图文件，每本工程图文件中需要一张装配体的三视图和其每个子零件的三视图图纸。并将它们存储在和“图纸”文件夹存放 solidworks 模型同级的名目下的“工程图”文件夹里。做好了预备工作，即可开头写程序。将需求的内容转化成软件问题描述，并描述其大致方法：1、得到产品文件的每个装配体：我们可以通过文件夹中文件的遍历，依据后缀名“.sldasm”来得到一个名目下全部的装配体；也可以通过遍历一个产品总 装配体的组件来得到每一个子装配体模型。实际的编码中我们选择了后者，由于它虽然给编写代码构造带来了简单度，但是正确性和稳定性都要好过前者。装配体的组件是一个树型构造，使用递归式是比
5、较敏捷的方法，前面章节也已经介绍过。2、生成工程图并插入零件的模型三视图：SolidWorks Task Scheduler 使用预定义的模型视图来完成自动生成的功能，但是，一旦需要在原有的图纸上插入图纸时，就不能够继承图纸模版的预定义试图了。所以需要使用CreateDrawViewFromModelView2 和 CreateUnfoldedViewAt3 来替代。一切预备完毕后就可以设计程序框架进展编码了：这里定义了三个过程， main、traverseasm、createdraw。它们的定义和完成的作用如下：Main：模块主函数没有参数和返回值，它得到当前翻开装配体的路径、设置“工程图文
6、件夹路径”、运行 traverseasm 过程。Traverseasm(filepath as string):此过程承受一个装配体的存储路径字符串参数，完成装配体的递归遍历工作，得到每一个装配体，并让每一个装配体都作为参数运行 createdraw 过程。Createdraw(filepath as string): 此过程承受一个装配体的存储路径字符串参数， 生成此装配体的工程图。”/*”drawcreator ： 依据装配体生成工程图”main:”get opened asm model infomation: ”filepathname”drawpathname”make dir pa
7、th 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
8、 ”*/Option Explicit ”定义局部：Dim SwAppAsDim DrawPathNameAs String Dim FileAs StringDim nErrorsAs Long Dim nWarningsAs LongDim StatofanNoAs Boolean Dim Pos As Integer ”/*”sub main goes here: ”* Sub MainOn Error Resume Next Dim ActModel AsDim YesOrNo As VbMsgBoxResult Set SwApp = CreateObject(“)Set ActMo
9、del =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
10、 nothing Set ActModel = NothingSet SwApp = NothingYesOrNo = MsgBox(“需要自动在零件工程图中插入模型工程么“, vbOKCancel, “提示“)If YesOrNo = vbOK Then StatofanNo = TrueElseStatofanNo = False End If= False”调用函数遍历装配体组件TraverseAsm File= True End Sub”/* ”sub traverseasm goes here : ”*Sub TraverseAsm(FilePath As String) ”Trav
11、erse Asm 遍历 ASM 文件Dim SwModel2 AsDim SwConf2 AsDim SwRootComp2 As Dim SwChildComp2 AsDim vChildComp2 As Variant Dim FileType2 As StringDim n As LongSet SwApp = CreateObject(“) If SwApp Is Nothing ThenMsgBox “创立 SW 对象失败“ Exit SubEnd IfSet SwModel2 = (FilePath, 2, 0, “, nErrors, nWarnings) ”file open
12、good If SwModel2 Is Nothing ThenMsgBox “加载装配体失败“Exit Sub End IfSet 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 TraverseAsmEnd If NextIf Not Mid,
13、1, 2) = “镜向“ Then CreateDrawEnd If End Sub”/* ”sub createdraw goes here : ”*/ Sub CreateDraw(FilePath As String)Dim SwModelAsDim SwSaveAsDim SwDrawAs Dim SwChildComp As Dim SwChildCmp2 As Dim SwConfAs Dim SwRootComp As Dim CurSheetAs Dim SwViewAsDim vChildComp As Variant Dim SheetArrAs String Dim Sp
14、adStrAs String Dim AsmFileAs String Dim DrawFielAs String Dim DrawDirAs String Dim DrawTempAs String Dim DeStringAs String Dim tmpStringAs String Dim sTmpStrAs String Dim FileTypeAs String Dim SheetNameAs String Dim ViewNameAs String Dim sFileNameAs StringDim FileAs StringDim iAs LongDim isOkAs Bool
15、ean Dim wGoodAs Integer AsmFile = FilePath DrawDir = DrawPathName”for easy to use i specified a template file DrawTemp = & “langchinese-simplifiedTutorial“ SheetArr = “ardenmakeastupidwaybutrunsok“Set SwApp = CreateObject(“) If SwApp Is Nothing ThenMsgBox “创立 SW 对象失败“ Exit SubEnd IfSet SwModel = (As
16、mFile, 2, 0, “, nErrors, nWarnings) If SwModel Is Nothing ThenMsgBox “翻开装配体失败“ Exit SubEnd If”创立 drawdoc 文档DrawTempSet SwDraw = (DrawTemp, 2, ,If SwDraw Is Nothing ThenMsgBox “创立工程图失败“ Exit SubEnd IfSet CurSheet =”插入模型到预定义视图isOk = (AsmFile)If isOk = False ThenMsgBox “插入装配体三视图失败“ End IfDeString =tmpS
17、tring = Left(DeString, InStrRev(DeString, “.“) - 1)If InStrRev(tmpString, “ “, -1, vbTextCompare) ”怎样才能不掩盖保存”then traverse all part file next level insert sheet on this draw ”已经将装配体的三视图插入 draw 文件了”要遍历装配体：part 局部” , True, nErrorsSet SwConf = ”need to change SwModel to traverse ” “activeconfiguration
18、is :“ &Set SwRootComp =” “rootcompoent is :“ & vChildComp =”开头对装配体下一层组建进展遍历，无视子装配体，只将本身和子零件出图-” ”begin loop-”For i = 0 To UBound(vChildComp)” “enter loop 0 to “ & UBound(vChildComp) Set SwChildComp = vChildComp(i)”-If i UBound(vChildComp) ThenSet SwChildCmp2 = vChildComp(i + 1) ElseSet SwChildCmp2 =
19、 vChildComp(0)End If” “sub comp “ & i & “ name is : “ & FileType = UCase(Right, 6)If FileType = “SLDPRT“ Then” 假设是零件，插入图纸If SwDraw Is Nothing Then” “SwDraw is nothing“Else” “SwDraw has :“ & & “sheets“End If ” - 1)” “2: “ & stmpstrsTmpStr = Right(sTmpStr, Len(sTmpStr) - InStrRev(sTmpStr, “) ” “3: “ &
20、 stmpstrIf InStr(sTmpStr, “ “) = 0 ThenSheetName = LTrim(sTmpStr) ElseSheetName = LTrim(Replace(sTmpStr, Left(sTmpStr, InStrRev(sTmpStr, “ “)- 1), “)End If” 得到图纸名称 lddrt“, 2, 2, “ SheetArr = SheetArr & SheetName “add“ & SheetArrSheetName Set CurSheet = True ” DrawTemp” “part fullname is :“ & ” 0, 0)
21、 ”右视TrueViewName, “DRAWINGVIEW“, 0, 0, 0, False, 0, Nothing, 0Set SwView = (0., 0., 0, 0) ”斜视True” viewname” , “DRAWINGVIEW“, 0, 0, 0, False, 0, Nothing, 0If Not SwView Is Nothing Then” “SwView name : “ &False, 3, False, True ” 隐蔽线可见” “scale : “ & (1)Else” “SwView is nothing “ End IfIf StatofanNo = True Then ”insert annotation0, 1605656, True, True, False, False ”斜视图为带边线上色Else”donothingEnd If” 创立三视图 LDDRW“isOk = (sFileName, 0, False, True)” “save “ & sfilename & “ state : “ & isok If isOk = False Then” “保存“ & sfilename & “失败“ End IfSet SwDraw = Nothing End Sub