根據(jù)裝配體生成工程圖的宏程序

1、在網(wǎng)上看到的：在WIN7 SW2014下現(xiàn)在不能用，看看改了能用不？煩請(qǐng)懂的人指點(diǎn)下，并將文件上傳到群里來(lái)：SolidWorks 生成工程圖紙程序下面代碼是工程圖助手中的“生成工程圖”模塊內(nèi)容。它按照我們的圖紙存儲(chǔ)規(guī)范，把一個(gè)產(chǎn)品的每個(gè)裝配體都生成一個(gè)solidworks的工程圖文件。面對(duì)一個(gè)問(wèn)題，我們?cè)谠噲D使用VBA來(lái)改善工作的時(shí)候，可以參考下面的思路來(lái)進(jìn)行，當(dāng)然，這也只是個(gè)人的一些經(jīng)驗(yàn)之說(shuō)，并不是最好的工作方式：首先我們需要了解實(shí)際工作情況，發(fā)現(xiàn)問(wèn)題所在：工藝人員在試圖提高solidworks工作效率的時(shí)候提到了使用SolidWorks Task Scheduler來(lái)自動(dòng)出圖紙的方法（具體

2、方法就不討論了）。大家經(jīng)過(guò)一段時(shí)間的使用后發(fā)現(xiàn)，使用SolidWorks Task Scheduler有一定的局限性，需要問(wèn)題在于，它將每個(gè)solidworks文件包括零件、裝配體都生成了一個(gè)工程圖文件。然而這樣得到的結(jié)果便是一個(gè)零部件稍多的產(chǎn)品，將會(huì)自動(dòng)生成很多的工程圖文件，不便于管理。我們的習(xí)慣是，按照裝配體來(lái)出圖紙，將一個(gè)裝配體中的零部件在一個(gè)工程圖文件中表示。這樣表達(dá)清楚而且便于管理。恩，這就是現(xiàn)實(shí)的問(wèn)題所在。然后，我們要考慮可行性：思考了SolidWorks Task Scheduler的實(shí)現(xiàn)，發(fā)現(xiàn)使用VBA在技術(shù)方面可以實(shí)現(xiàn)此類功能，并且有一定的規(guī)律可以遵守而不需要太多的人為判斷就

3、可以達(dá)到要求。這里插一句，在使用SolidWorks Task Scheduler時(shí)我發(fā)現(xiàn)了一個(gè)選項(xiàng)：備份任務(wù)文件，而這個(gè)任務(wù)文件上所記錄的正式一段使用VBA寫(xiě)的宏代碼。接下來(lái)，需要現(xiàn)場(chǎng)調(diào)研確定需求目標(biāo)：在了解了solidworks使用相應(yīng)的規(guī)范和工藝員在實(shí)際工作中的要求后我們對(duì)問(wèn)題目標(biāo)有了一個(gè)比較明確的概念。我們要做的項(xiàng)目需要完成這樣的工作：它針對(duì)一個(gè)產(chǎn)品中的每個(gè)裝配體生成一個(gè)工作圖文件，每本工程圖文件中需要一張裝配體的三視圖和其每個(gè)子零件的三視圖圖紙。并將它們存儲(chǔ)在和“圖紙”文件夾（存放solidworks模型）同級(jí)的目錄下的“工程圖”文件夾里。做好了準(zhǔn)備工作，即可開(kāi)始寫(xiě)程序。將需求的內(nèi)容

4、轉(zhuǎn)化成軟件問(wèn)題描述，并描述其大致方法：1、得到產(chǎn)品文件的每個(gè)裝配體：我們可以通過(guò)文件夾中文件的遍歷，按照后綴名“.sldasm”來(lái)得到一個(gè)目錄下所有的裝配體；也可以通過(guò)遍歷一個(gè)產(chǎn)品總裝配體的組件來(lái)得到每一個(gè)子裝配體模型。實(shí)際的編碼中我們選擇了后者，因?yàn)樗m然給編寫(xiě)代碼結(jié)構(gòu)帶來(lái)了復(fù)雜度，但是正確性和穩(wěn)定性都要好過(guò)前者。裝配體的組件是一個(gè)樹(shù)型結(jié)構(gòu)，使用遞歸式是比較靈活的方法，前面章節(jié)也已經(jīng)介紹過(guò)。2、生成工程圖并插入零件的模型三視圖：SolidWorks Task Scheduler使用預(yù)定義的模型視圖來(lái)完成自動(dòng)生成的功能，但是，一旦需要在原有的圖紙上插入新圖紙時(shí)，就不能夠繼承圖紙模版的預(yù)定義試圖

5、了。所以需要使用CreateDrawViewFromModelView2和CreateUnfoldedViewAt3來(lái)替代。一切準(zhǔn)備完畢后就可以設(shè)計(jì)程序框架進(jìn)行編碼了：這里定義了三個(gè)過(guò)程，main、traverseasm、createdraw。它們的定義和完成的作用如下：Main（）：模塊主函數(shù)沒(méi)有參數(shù)和返回值，它得到當(dāng)前打開(kāi)裝配體的路徑、設(shè)置“工程圖文件夾路徑”、運(yùn)行traverseasm過(guò)程。Traverseasm(filepath as string):此過(guò)程接受一個(gè)裝配體的存儲(chǔ)路徑字符串參數(shù)，完成裝配體的遞歸遍歷工作，得到每一個(gè)裝配體，并讓每一個(gè)裝配體都作為參數(shù)運(yùn)行createdraw

6、過(guò)程。Createdraw(filepath as string): 此過(guò)程接受一個(gè)裝配體的存儲(chǔ)路徑字符串參數(shù)，生成此裝配體的工程圖。/*drawcreator ： 根據(jù)裝配體生成工程圖main: get opened asm model infomation: filepathname drawpathname make dir path is drawpathname call traverseasm with argument filepathnametraverseasm: for itself call createdraw with argument itself traverse

7、 the asm model component for each sub asm model: call traverseasmcreatedraw: create a drawdoc with given DrawTemplate insert each sub part model component a sheet*/Option Explicit定義部分： Dim SwApp As SldWorks.SldWorks Dim DrawPathName As String Dim File As String Dim nErrors As Long Dim nWarnings As L

8、ong Dim StatofanNo As Boolean Dim Pos As Integer /* sub main goes here: *Sub Main() On Error Resume Next Dim ActModel As SldWorks.ModelDoc2 Dim YesOrNo As VbMsgBoxResult Set SwApp = CreateObject(SldWorks.Application) Set ActModel = SwApp.ActiveDoc If ActModel Is Nothing Then MsgBox 請(qǐng)先打開(kāi)裝配體 End If 得到

9、裝配體文件路徑 File = ActModel.GetPathName 得到工程圖保存路徑 DrawPathName = Left(File, InStrRev(File, ) - 1) DrawPathName = Left(DrawPathName, InStrRev(DrawPathName, ) DrawPathName = DrawPathName + 工程圖 創(chuàng)建文件夾 MkDir (DrawPathName) 調(diào)試信息 : Debug.Print DrawPathName Debug.Print File should i set all object nothing ? Set

10、 ActModel = Nothing Set SwApp = Nothing YesOrNo = MsgBox(需要自動(dòng)在零件工程圖中插入模型項(xiàng)目么？, vbOKCancel, 提示) If YesOrNo = vbOK Then StatofanNo = True Else StatofanNo = False End If SwApp.Visible = False 調(diào)用函數(shù)遍歷裝配體組件 TraverseAsm File SwApp.Visible = TrueEnd Sub/*sub traverseasm goes here :*Sub TraverseAsm(FilePath A

11、s String) Traverse Asm 遍歷ASM文件 Dim SwModel2 As SldWorks.ModelDoc2 Dim SwConf2 As SldWorks.Configuration Dim SwRootComp2 As SldWorks.Component2 Dim SwChildComp2 As SldWorks.Component2 Dim vChildComp2 As Variant Dim FileType2 As String Dim n As Long Set SwApp = CreateObject(SldWorks.Application) If Sw

12、App Is Nothing Then MsgBox 創(chuàng)建SW對(duì)象失敗 Exit Sub End If Set SwModel2 = SwApp.OpenDoc6(FilePath, 2, 0, , nErrors, nWarnings) file open good If SwModel2 Is Nothing Then MsgBox 加載裝配體失敗 Exit Sub End If Set SwConf2 = SwModel2.GetActiveConfiguration need to change SwModel to traverse Set SwRootComp2 = SwConf2

13、.GetRootComponent vChildComp2 = SwRootComp2.GetChildren For n = 0 To UBound(vChildComp2) Set SwChildComp2 = vChildComp2(n) FileType2 = UCase(Right(SwChildComp2.GetPathName, 6) If FileType2 = SLDASM Then TraverseAsm SwChildComp2.GetPathName End If Next Debug.Print SwModel2.GetPathName If Not Mid(SwMo

14、del2.GetTitle, 1, 2) = 鏡向 Then CreateDraw SwModel2.GetPathName End IfEnd Sub/*sub createdraw goes here :*/Sub CreateDraw(FilePath As String) Dim SwModel As SldWorks.ModelDoc2 Dim SwSave As SldWorks.ModelDoc2 Dim SwDraw As SldWorks.DrawingDoc Dim SwChildComp As SldWorks.Component2 Dim SwChildCmp2 As

15、SldWorks.Component2 Dim SwConf As SldWorks.Configuration Dim SwRootComp As SldWorks.Component2 Dim CurSheet As SldWorks.Sheet Dim SwView As SldWorks.View Dim vChildComp As Variant Dim SheetArr As String Dim SpadStr As String Dim AsmFile As String Dim DrawFiel As String Dim DrawDir As String Dim Draw

16、Temp As String Dim DeString As String Dim tmpString As String Dim sTmpStr As String Dim FileType As String Dim SheetName As String Dim ViewName As String Dim sFileName As String Dim File As String Dim i As Long Dim isOk As Boolean Dim wGood As Integer AsmFile = FilePath DrawDir = DrawPathName for ea

17、sy to use i specified a template file DrawTemp = SwApp.GetExecutablePath & langchinese-simplifiedTutorialauto.DRWDOT SheetArr = ardenmakeastupidwaybutrunsok Set SwApp = CreateObject(SldWorks.Application) If SwApp Is Nothing Then MsgBox 創(chuàng)建SW對(duì)象失敗 Exit Sub End If Set SwModel = SwApp.OpenDoc6(AsmFile, 2

18、, 0, , nErrors, nWarnings) If SwModel Is Nothing Then MsgBox 打開(kāi)裝配體失敗 Exit Sub End If SwModel.EditRebuild3 創(chuàng)建drawdoc文檔 Debug.Print DrawTemp Set SwDraw = SwApp.NewDocument(DrawTemp, 2, 0.2, 0.4) If SwDraw Is Nothing Then MsgBox 創(chuàng)建工程圖失敗 Exit Sub End If Set CurSheet = SwDraw.GetCurrentSheet 插入模型到預(yù)定義視圖 i

19、sOk = SwDraw.InsertModelInPredefinedView(AsmFile) If isOk = False Then MsgBox 插入裝配體三視圖失敗 End If DeString = SwModel.GetTitle tmpString = Left(DeString, InStrRev(DeString, .) - 1) If InStrRev(tmpString, , -1, vbTextCompare) 怎樣才能不覆蓋保存？ then traverse all part file next level insert sheet on this draw 已經(jīng)

20、將裝配體的三視圖插入draw文件了 要遍歷裝配體：part部分 SwApp.ActivateDoc2 SwModel.GetPathName, True, nErrors Set SwConf = SwModel.GetActiveConfiguration need to change SwModel to traverse debug.print activeconfiguration is : & SwConf.Name Set SwRootComp = SwConf.GetRootComponent debug.print rootcompoent is : & SwRootComp.

21、Name vChildComp = SwRootComp.GetChildren 開(kāi)始對(duì)裝配體下一層組建進(jìn)行遍歷，忽略子裝配體，只將本身和子零件出圖- begin loop- For i = 0 To UBound(vChildComp) debug.print enter loop 0 to & UBound(vChildComp) Set SwChildComp = vChildComp(i) - If i UBound(vChildComp) Then Set SwChildCmp2 = vChildComp(i + 1) Else Set SwChildCmp2 = vChildCom

22、p(0) End If debug.print sub comp & i & name is : & SwChildComp.Name FileType = UCase(Right(SwChildComp.GetPathName, 6) If FileType = SLDPRT Then 如果是零件，插入圖紙 If SwDraw Is Nothing Then debug.print SwDraw is nothing Else debug.print SwDraw has : & SwDraw.GetSheetCount & sheets End If / 得到圖紙名稱 sTmpStr =

23、SwChildComp.GetPathName debug.print 1: & stmpstr sTmpStr = Left(sTmpStr, InStrRev(sTmpStr, .) - 1) debug.print 2: & stmpstr sTmpStr = Right(sTmpStr, Len(sTmpStr) - InStrRev(sTmpStr, ) debug.print 3: & stmpstr If InStr(sTmpStr, ) = 0 Then SheetName = LTrim(sTmpStr) Else SheetName = LTrim(Replace(sTmp

24、Str, Left(sTmpStr, InStrRev(sTmpStr, ) - 1), ) End If 得到圖紙名稱/ Debug.Print sheetname: & SheetName Debug.Print SheetArr & SheetArr 忽略鏡像零部件 If Not Mid(SheetName, 1, 2) = 鏡向 Then /-如果重復(fù)跳過(guò)If Not SwChildComp.GetPathName = SwChildCmp2.GetPathName Then /-也是判斷有沒(méi)有這個(gè)表 If InStr(1, SheetArr, SheetName, vbTextCom

25、pare) = 0 Then If Not InStrRev(1, SheetArr, sheetname, vbTextCompare) = 0 Then SwDraw.NewSheet3 SheetName, 12, 12, 1#, 10#, True, 美克A4橫.slddrt, 2, 2, SheetArr = SheetArr & SheetName Debug.Print add & SheetArr SwDraw.ActivateSheet SheetName Set CurSheet = SwDraw.GetCurrentSheet CurSheet.SheetFormatVi

26、sible = TrueCurSheet.SetTemplateName DrawTempdebug.print part fullname is : & SwChildComp.GetPathNameSwDraw.InsertModelInPredefinedView SwChildComp.GetPathName/- 創(chuàng)建三視圖- Set SwView = SwDraw.CreateDrawViewFromModelView2(SwChildComp.GetPathName, *前視, 0.07954434782609, 0.09376565217391, 0)debug.print vi

27、ewname is : & SwView.Name ViewName = SwView.Namedebug.print SwView name is : & viewname SwDraw.Extension.SelectByID2 ViewName, DRAWINGVIEW, 0, 0, 0, False, 0, Nothing, 0 SwDraw.ActivateView ViewName Set SwView = SwDraw.CreateUnfoldedViewAt3(0.2224917391304, 0.09376565217391, 0, 0) 上視 SwDraw.ClearSelection2 True SwDraw.Extension.SelectByID2 ViewName, DRAWINGVIEW, 0, 0, 0, False, 0, Nothing, 0 SwDraw.ClearSelection2 True SwDraw.Extension.SelectByID2 ViewName, DRAWINGVIEW, 0, 0, 0, False, 0, Nothing, 0 SwDraw.ClearSelection2 TrueSw