SolidWorks根据装配体生成工程图的宏程序

1、在网上看到的：在WIN7SW2014F现在不能用，看看改了能用不？烦请懂的人指点下，并将文件上传到群里来：SolidWorks生成工程图纸程序下面代码是工程图助手中的“生成工程图”模块内容。它按照我们的图纸存储规范，把一个产品的每个装配体都生成一个solidworks的工程图文件。面对一个问题，我们在试图使用VBA来改善工作的时候，可以参考下面的思路来进行，当然，这也只是个人的一些经验之说，并不是最好的工作方式：首先我们需要了解实际工作情况，发现问题所在：工艺人员在试图提高solidworks工作效率的时候提到了使用SolidWorksTaskScheduler来自动出图纸的方法（具体方法就不

2、讨论了）。大家经过一段时间的使用后发现，使用SolidWorksTaskScheduler有一定的局限性，需要问题在于，它将每个solidworks文件一包括零件、装配体一都生成了一个工程图文件。然而这样得到的结果便是一个零部件稍多的产品，将会自动生成很多的工程图文件，不便于管理。我们的习惯是，按照装配体来出图纸，将一个装配体中的零部件在一个工程图文件中表示。这样表达清楚而且便于管理。恩，这就是现实的问题所在。然后，我们要考虑可行性：思考了SolidWorksTaskScheduler的实现，发现使用VBA在技术方面可以实现此类功能，并且有一定的规律可以遵守而不需要太多的人为判断就可以达到要求

3、。这里插一句，在使用SolidWorksTaskScheduler时我发现了一个选项：备份任务文件，而这个任务文件上所记录的正式一段使用VBA写的宏代码。接下来，需要现场调研确定需求目标：在了解了solidworks使用相应的规范和工艺员在实际工作中的要求后我们对问题目标有了一个比较明确的概念。我们要做的项目需要完成这样的工作：它针对一个产品中的每个装配体生成一个工作图文件，每本工程图文件中需要一张装配体的三视图和其每个子零件的三视图图纸。并将它们存储在和“图纸”文件夹（存放solidworks模型）同级的目录下的“工程图”文件夹里。做好了准备工作，即可开始写程序。将需求的内容转化成软件问题描

4、述，并描述其大致方法：1、得到产品文件的每个装配体：我们可以通过文件夹中文件的遍历，按照后缀名”.sldasm”来得到一个目录下所有的装配体；也可以通过遍历一个产品总装配体的组件来得到每一个子装配体模型。实际的编码中我们选择了后者，因为它虽然给编写代码结构带来了复杂度，但是正确性和稳定性都要好过前者。装配体的组件是一个树型结构，使用递归式是比较灵活的方法，前面章节也已经介绍过。2、生成工程图并插入零件的模型三视图：SolidWorksTaskScheduler使用预定义的模型视图来完成自动生成的功能，但是，一旦需要在原有的图纸上插入新图纸时，就不能够继承图纸模版的预定义试图了。所以需要使用Cr

5、eateDrawViewFromModelView2和CreateUnfoldedViewAt3来替代。一切准备完毕后就可以设计程序框架进行编码了：这里定义了三个过程，main、traverseasm、createdraw。它们的定义和完成的作用如下：Main（）:模块主函数没有参数和返回值，它得到当前打开装配体的路径、设置”工程图文件夹路径”、运行traverseasm过程。Traverseasm(filepathasstring):此过程接受一个装配体的存储路径字符用参数，完成装配体的递归遍历工作，得到每一个装配体，并让每一个装配体都作为参数运行createdraw过程。Createdra

6、w(filepathasstring):此过程接受一个装配体的存储路径字符串参数，生成此装配体的工程图。、产*'drawcreator:根据装配体生成工程图'main:'getopenedasmmodelinfomation:'filepathname'drawpathname'makedirpathisdrawpathname'calltraverseasmwithargumentfilepathname''traverseasm:'foritselfcallcreatedrawwithargumentitsel

7、f'traversetheasmmodelcomponent'foreachsubasmmodel:'calltraverseasm''createdraw:'createadrawdocwithgivenDrawTemplate'inserteachsubpartmodelcomponentasheet*/OptionExplicit,定义部分：AsSldWorks.SldWorksDimSwAppDimDrawPathNameAsStringDimFileAsStringDimnErrorsAsLongDimnWarningsAsLo

8、ngDimStatofanNoAsBooleanDimPosAsInteger|/*'submaingoeshere:I*SubMain()OnErrorResumeNextDimActModelAsSldWorks.ModelDoc2DimYesOrNoAsVbMsgBoxResultSetSwApp=CreateObject("SldWorks.Application")SetActModel=SwApp.ActiveDocIfActModelIsNothingThenMsgBox"请先打开装配体"EndIf,得到装配体文件路径File=Ac

9、tModel.GetPathName,得到工程图保存路径DrawPathName=Left(File,InStrRev(File,"")-1)DrawPathName=Left(DrawPathName,InStrRev(DrawPathName,"")DrawPathName=DrawPathName+"工程图"'创建文件夹MkDir(DrawPathName)'调试信息：Debug.PrintDrawPathNameDebug.PrintFile'shouldisetallobjectnothing?Set

10、ActModel=NothingSetSwApp=NothingYesOrNo=MsgBox("需要自动在零件工程图中插入模型项目么？",vbOKCancel,"提示")IfYesOrNo=vbOKThenStatofanNo=TrueElseStatofanNo=FalseEndIfSwApp.Visible=False'调用函数遍历装配体组件TraverseAsmFileSwApp.Visible=TrueEndSub'/*'subtraverseasmgoeshere:''*SubTraverseAsm(Fi

11、lePathAsString)'TraverseAsm遍历ASMfc件DimSwModel2AsSldWorks.ModelDoc2DimSwConf2AsSldWorks.ConfigurationDimSwRootComp2AsSldWorks.Component2DimSwChildComp2AsSldWorks.Component2DimvChildComp2AsVariantDimFileType2AsStringDimnAsLongSetSwApp=CreateObject("SldWorks.Application")IfSwAppIsNothingT

12、henMsgBox"创建SW寸象失败"ExitSubEndIfSetSwModel2=SwApp.OpenDoc6(FilePath,2,0,"",nErrors,nWarnings)'fileopengoodIfSwModel2IsNothingThenMsgBox"加载装配体失败"ExitSubEndIfSetSwConf2=SwModel2.GetActiveConfiguration'needtochangeSwModeltotraverseSetSwRootComp2=SwConf2.GetRootCompo

13、nentvChildComp2=SwRootComp2.GetChildrenForn=0ToUBound(vChildComp2)SetSwChildComp2=vChildComp2(n)FileType2=UCase(Right(SwChildComp2.GetPathName,6)IfFileType2="SLDASM"ThenTraverseAsmSwChildComp2.GetPathNameEndIfNextDebug.PrintSwModel2.GetPathNameIfNotMid(SwModel2.GetTitle,1,2)="镜向"

14、ThenCreateDrawSwModel2.GetPathNameEndIfEndSub、产*'subcreatedrawgoeshere:'*/SubCreateDraw(FilePathAsString)DimSwModelAsSldWorks.ModelDoc2DimSwSaveAsSldWorks.ModelDoc2DimSwDrawAsSldWorks.DrawingDocDimSwChildCompAsSldWorks.Component2DimSwChildCmp2AsSldWorks.Component2DimSwConfAsSldWorks.Configur

15、ationDimSwRootCompAsSldWorks.Component2DimCurSheetAsSldWorks.SheetDimSwViewAsSldWorks.ViewDimvChildCompAsVariantDimSheetArrAsStringDimSpadStrAsStringDimAsmFileAsStringDimDrawFielAsStringDimDrawDirAsStringDimDrawTempAsStringDimDeStringAsStringDimtmpStringAsStringDimsTmpStrAsStringDimFileTypeAsStringD

16、imSheetNameAsStringDimViewNameAsStringDimsFileNameAsStringDimFileAsStringDimiAsLongDimisOkAsBooleanDimwGoodAsIntegerAsmFile=FilePathDrawDir=DrawPathName'foreasytouseispecifiedatemplatefileDrawTemp=SwApp.GetExecutablePath&langchinese-simplifiedTutorialauto.DRWDOT"SheetArr="ardenmake

17、astupidwaybutrunsok”SetSwApp=CreateObject("SldWorks.Application")IfSwAppIsNothingThenMsgBox"创建SW寸象失败"ExitSubEndIfSetSwModel=SwApp.OpenDoc6(AsmFile,2,0,"",nErrors,nWarnings)IfSwModelIsNothingThenMsgBox"打开装配体失败"ExitSubEndIfSwModel.EditRebuild3'创建drawdoc文档Deb

18、ug.PrintDrawTempSetSwDraw=SwApp.NewDocument(DrawTemp,2,0.2,0.4)IfSwDrawIsNothingThenMsgBox"创建工程图失败"ExitSubEndIfSetCurSheet=SwDraw.GetCurrentSheet'插入模型到预定义视图isOk=SwDraw.InsertModelInPredefinedView(AsmFile)IfisOk=FalseThenMsgBox"插入装配体三视图失败"EndIfDeString=SwModel.GetTitletmpStrin

19、g=Left(DeString,InStrRev(DeString,".")-1)IfInStrRev(tmpString,"”,-1,vbTextCompare)<=0ThenDeString=tmpString'notice:needtowritemoretomodifyitElseDeString=Replace(tmpString,Left(tmpString,InStrRev(tmpString,”")-1)EndIf,sheet名称设定规则：模型名称(不包括物料编码)+三视图CurSheet.SetName(DeString+&

20、quot;三视图")SetSwView=SwDraw.GetFirstViewSwView.UseSheetScale=True'设置为图纸比例doesitworksright?''debug.printSwView.UseSheetScale'''debug.print"thesheetnameis:"&destring+"三视图"'savedrawfilebutdonotopenitwGood=SwModel.SaveAs2(DrawDir+tmpString+”.SLDDRW

21、",0,False,True)'''debug.print"saveasmdrawfilestate:"&wgood'''debug.printDrawDir&""&tmpstring&".SLDDRW"IfwGood=0ThenMsgBox"保存三视图失败"EndIf'>>>,怎样才能不覆盖保存？'thentraverseallpartfilenextlevelinsertsheetonth

22、isdraw,已经将装配体的三视图插入draw文件了,要遍历装配体：part部分'SwApp.ActivateDoc2SwModel.GetPathName,True,nErrorsSetSwConf=SwModel.GetActiveConfiguration'needtochangeSwModeltotraverse'''debug.print"activeconfigurationis:"&SwConf.NameSetSwRootComp=SwConf.GetRootComponent'''deb

23、ug.print"rootcompoentis:"&SwRootComp.NamevChildComp=SwRootComp.GetChildren,开始对装配体下一层组建进行遍历，忽略子装配体，只将本身和子零件出图-,'beginloop'Fori=0ToUBound(vChildComp)'''debug.print"enterloop0to"&UBound(vChildComp)SetSwChildComp=vChildComp(i)'Ifi<UBound(vChildComp)

24、ThenSetSwChildCmp2=vChildComp(i+1)ElseSetSwChildCmp2=vChildComp(0)EndIf'''debug.print"subcomp"&i&"nameis:"&SwChildComp.NameFileType=UCase(Right(SwChildComp.GetPathName,6)IfFileType="SLDPRT"Then'如果是零件，插入图纸IfSwDrawIsNothingThen'''de

25、bug.print"SwDrawisnothing"Else'''debug.print"SwDrawhas:"&SwDraw.GetSheetCount&"sheets"EndIf”/得到图纸名称sTmpStr=SwChildComp.GetPathName''debug.print"1:"&stmpstrsTmpStr=Left(sTmpStr,InStrRev(sTmpStr,".")-1)''debug.pr

26、int"2:"&stmpstrsTmpStr=Right(sTmpStr,Len(sTmpStr)-InStrRev(sTmpStr,"")''debug.print"3:"&stmpstrIfInStr(sTmpStr,"")<=0ThenSheetName=LTrim(sTmpStr)ElseSheetName=LTrim(Replace(sTmpStr,Left(sTmpStr,InStrRev(sTmpStr,"")-1),"")

27、EndIf'得到图纸名称Debug.Print"sheetname:"&SheetNameDebug.Print"SheetArr"&SheetArr'忽略镜像零部件IfNotMid(SheetName,1,2)="镜向"Then'/-如果重复跳过IfNotSwChildComp.GetPathName=SwChildCmp2.GetPathNameThen'/-也是判断有没有这个表IfInStr(1,SheetArr,SheetName,vbTextCompare)=0Then'

28、;IfNotInStrRev(1,SheetArr,sheetname,vbTextCompare)=0ThenSwDraw.NewSheet3SheetName,12,12,1#,10#,True,"美克A4横.slddrt",2,2,""SheetArr=SheetArr&SheetNameDebug.Print"add"&SheetArrSwDraw.ActivateSheetSheetNameSetCurSheet=SwDraw.GetCurrentSheetCurSheet.SheetFormatVisibl

29、e=True'CurSheet.SetTemplateNameDrawTemp'''debug.print"partfullnameis:"&SwChildComp.GetPathName'SwDraw.InsertModelInPredefinedViewSwChildComp.GetPathName'/-创建三视图-SetSwView=SwDraw.CreateDrawViewFromModelView2(SwChildComp.GetPathName,"*前视",0.0795443478260

30、9,0.09376565217391,0)'''debug.print"viewnameis:"&SwView.NameViewName=SwView.Name'''debug.print"SwViewnameis:"&viewnameSwDraw.Extension.SelectByID2ViewName,"DRAWINGVIEW",0,0,0,False,0,Nothing,0SwDraw.ActivateViewViewNameSetSwView=SwDraw.Cr

31、eateUnfoldedViewAt3(0.2224917391304,0.09376565217391,0,0)'上视SwDraw.ClearSelection2TrueSwDraw.Extension.SelectByID2ViewName,"DRAWINGVIEW",0,0,0,False,0,Nothing,0SetSwView=SwDraw.CreateUnfoldedViewAt3(0.07954434782609,0.1534239130435,0,0)'右视SwDraw.ClearSelection2TrueSwDraw.Extension.SelectByID2ViewName,"DRAWINGVIEW",0,0,0,False,0,Nothing,0SetSwView=SwDraw.CreateUnfoldedViewAt3(0.1636082608696,0.1778295652174,0,0)斜视SwDraw.ClearSelection2True'S