SolidWorks根据装配体生成工程图的宏程序文档格式.docx

SolidWorks根据装配体生成工程图的宏程序文档格式.docx

《SolidWorks根据装配体生成工程图的宏程序文档格式.docx》由会员分享，可在线阅读，更多相关《SolidWorks根据装配体生成工程图的宏程序文档格式.docx（12页珍藏版）》请在冰豆网上搜索。

SolidWorksTaskScheduler使用预定义的模型视图来完成自动生成的功能，但是，一旦需要在原有的图纸上插入新图纸时，就不能够继承图纸模版的预定义试图了。

所以需要使用CreateDrawViewFromModelView2和CreateUnfoldedViewAt3来替代。

一切准备完毕后就可以设计程序框架进行编码了：

这里定义了三个过程，main、traverseasm、createdraw。

它们的定义和完成的作用如下：

Main（）：

模块主函数没有参数和返回值，它得到当前打开装配体的路径、设置“工程图文件夹路径”、运行traverseasm过程。

Traverseasm（filepathasstring）:

此过程接受一个装配体的存储路径字符串参数，完成装配体的递归遍历工作，得到每一个装配体，并让每一个装配体都作为参数运行createdraw过程。

Createdraw（filepathasstring）:

此过程接受一个装配体的存储路径字符串参数，生成此装配体的工程图。

'

/************************************************************

drawcreator：

根据装配体生成工程图

main:

getopenedasmmodelinfomation:

filepathname

drawpathname

makedirpathisdrawpathname

calltraverseasmwithargumentfilepathname'

traverseasm:

foritselfcallcreatedrawwithargumentitself

traversetheasmmodelcomponent

foreachsubasmmodel:

calltraverseasm'

createdraw:

createadrawdocwithgivenDrawTemplate

inserteachsubpartmodelcomponentasheet

************************************************************/

OptionExplicit

定义部分：

DimSwAppAsSldWorks.SldWorks

DimDrawPathNameAsString

DimFileAsString

DimnErrorsAsLong

DimnWarningsAsLong

DimStatofanNoAsBoolean

DimPosAsInteger

'

/******************

submaingoeshere:

*******************

SubMain（）

OnErrorResumeNext

DimActModelAsSldWorks.ModelDoc2

DimYesOrNoAsVbMsgBoxResult

SetSwApp=CreateObject（"

SldWorks.Application"

）

SetActModel=SwApp.ActiveDoc

IfActModelIsNothingThen

MsgBox"

请先打开装配体"

EndIf

得到装配体文件路径

File=ActModel.GetPathName

得到工程图保存路径

DrawPathName=Left（File,InStrRev（File,"

\"

）-1）

DrawPathName=Left（DrawPathName,InStrRev（DrawPathName,"

））

DrawPathName=DrawPathName+"

工程图\"

创建文件夹

MkDir（DrawPathName）

调试信息:

Debug.PrintDrawPathName

Debug.PrintFile

shouldisetallobjectnothing?

SetActModel=Nothing

SetSwApp=Nothing

YesOrNo=MsgBox（"

需要自动在零件工程图中插入模型项目么？

"

vbOKCancel,"

提示"

IfYesOrNo=vbOKThen

StatofanNo=True

Else

StatofanNo=False

SwApp.Visible=False

调用函数遍历装配体组件

TraverseAsmFile

SwApp.Visible=True

EndSub

/************************

subtraverseasmgoeshere:

*************************

SubTraverseAsm（FilePathAsString）'

TraverseAsm遍历ASM文件

DimSwModel2AsSldWorks.ModelDoc2

DimSwConf2AsSldWorks.Configuration

DimSwRootComp2AsSldWorks.Component2

DimSwChildComp2AsSldWorks.Component2

DimvChildComp2AsVariant

DimFileType2AsString

DimnAsLong

IfSwAppIsNothingThen

创建SW对象失败"

ExitSub

SetSwModel2=SwApp.OpenDoc6（FilePath,2,0,"

nErrors,nWarnings）'

fileopengood

IfSwModel2IsNothingThen

加载装配体失败"

SetSwConf2=SwModel2.GetActiveConfiguration'

needtochangeSwModeltotraverse

SetSwRootComp2=SwConf2.GetRootComponent

vChildComp2=SwRootComp2.GetChildren

Forn=0ToUBound（vChildComp2）

SetSwChildComp2=vChildComp2（n）

FileType2=UCase（Right（SwChildComp2.GetPathName,6））

IfFileType2="

SLDASM"

Then

TraverseAsmSwChildComp2.GetPathName

Next

Debug.PrintSwModel2.GetPathName

IfNotMid（SwModel2.GetTitle,1,2）="

镜向"

CreateDrawSwModel2.GetPathName

/**************************************************

subcreatedrawgoeshere:

**************************************************/

SubCreateDraw（FilePathAsString）

DimSwModelAsSldWorks.ModelDoc2

DimSwSaveAsSldWorks.ModelDoc2

DimSwDrawAsSldWorks.DrawingDoc

DimSwChildCompAsSldWorks.Component2

DimSwChildCmp2AsSldWorks.Component2

DimSwConfAsSldWorks.Configuration

DimSwRootCompAsSldWorks.Component2

DimCurSheetAsSldWorks.Sheet

DimSwViewAsSldWorks.View

DimvChildCompAsVariant

DimSheetArrAsString

DimSpadStrAsString

DimAsmFileAsString

DimDrawFielAsString

DimDrawDirAsString

DimDrawTempAsString

DimDeStringAsString

DimtmpStringAsString

DimsTmpStrAsString

DimFileTypeAsString

DimSheetNameAsString

DimViewNameAsString

DimsFileNameAsString

DimiAsLong

DimisOkAsBoolean

DimwGoodAsInteger

AsmFile=FilePath

DrawDir=DrawPathName

foreasytouseispecifiedatemplatefile

DrawTemp=SwApp.GetExecutablePath&

"

\lang\chinese-simplified\Tutorial\auto.DRWDOT"

SheetArr="

ardenmakeastupidwaybutrunsok"

SetSwModel=SwApp.OpenDoc6（AsmFile,2,0,"

nErrors,nWarnings）

IfSwModelIsNothingThen

打开装配体失败"

SwModel.EditRebuild3

创建drawdoc文档

Debug.PrintDrawTemp

SetSwDraw=SwApp.NewDocument（DrawTemp,2,0.2,0.4）

IfSwDrawIsNothingThen

创建工程图失败"

SetCurSheet=SwDraw.GetCurrentSheet

插入模型到预定义视图

isOk=SwDraw.InsertModelInPredefinedView（AsmFile）

IfisOk=FalseThen

插入装配体三视图失败"

DeString=SwModel.GetTitle

tmpString=Left（DeString,InStrRev（DeString,"

."

IfInStrRev（tmpString,"

-1,vbTextCompare）<

=0Then

DeString=tmpString

notice:

needtowritemoretomodifyit

DeString=Replace（tmpString,Left（tmpString,InStrRev（tmpString,"

）-1）,"

sheet名称设定规则：

模型名称（不包括物料编码）+三视图

CurSheet.SetName（DeString+"

三视图"

SetSwView=SwDraw.GetFirstView

SwView.UseSheetScale=True'

设置为图纸比例doesitworksright？

debug.printSwView.UseSheetScale

debug.print"

thesheetnameis:

&

destring+"

savedrawfilebutdonotopenit

wGood=SwModel.SaveAs2（DrawDir+tmpString+"

.SLDDRW"

0,False,True）

saveasmdrawfilestate:

wgood

debug.printDrawDir&

tmpstring&

IfwGood=0Then

保存三视图失败"

>

怎样才能不覆盖保存？

thentraverseallpartfilenextlevelinsertsheetonthisdraw

已经将装配体的三视图插入draw文件了

要遍历装配体：

part部分

SwApp.ActivateDoc2SwModel.GetPathName,True,nErrors

SetSwConf=SwModel.GetActiveConfiguration'

activeconfigurationis:

SwConf.Name

SetSwRootComp=SwConf.GetRootComponent

rootcompoentis:

SwRootComp.Name

vChildComp=SwRootComp.GetChildren

开始对装配体下一层组建进行遍历，忽略子装配体，只将本身和子零件出图-'

beginloop-

Fori=0ToUBound（vChildComp）

enterloop0to"

UBound（vChildComp）

SetSwChildComp=vChildComp（i）

-

Ifi<

UBound（vChildComp）Then

SetSwChildCmp2=vChildComp（i+1）

SetSwChildCmp2=vChildComp（0）

subcomp"

i&

nameis:

SwChildComp.Name

FileType=UCase（Right（SwChildComp.GetPathName,6））

IfFileType="

SLDPRT"

Then'

如果是零件，插入图纸

SwDrawisnothing"

SwDrawhas:

SwDraw.GetSheetCount&

sheets"

//得到图纸名称

sTmpStr=SwChildComp.GetPathName

1:

stmpstr

sTmpStr=Left（sTmpStr,InStrRev（sTmpStr,"

2:

sTmpStr=Right（sTmpStr,Len（sTmpStr）-InStrRev（sTmpStr,"

3:

IfInStr（sTmpStr,"

）<

SheetName=LTrim（sTmpStr）

SheetName=LTrim（Replace（sTmpStr,Left（sTmpStr,InStrRev（sTmpStr,"

得到图纸名称//

Debug.Print"

sheetname:

SheetName

SheetArr"

SheetArr

忽略镜像零部件

IfNotMid（SheetName,1,2）="

//-如果重复跳过IfNotSwChildComp.GetPathName=SwChildCmp2.GetPathNameThen

//-也是判断有没有这个表

IfInStr（1,SheetArr,SheetName,vbTextCompare）=0Then

IfNotInStrRev（1,SheetArr,sheetname,vbTextCompare）=0Then

SwDraw.NewSheet3SheetName,12,12,1#,10#,True,"

美克A4横.slddrt"

2,2,"

SheetArr=SheetArr&

add"

SwDraw.ActivateSheetSheetName

CurSheet.SheetFormatVisible=True

CurSheet.SetTemplateNameDrawTemp

partfullnameis:

SwChildComp.GetPathName

SwDraw.InsertModelInPredefinedViewSwChildComp.GetPathName

//-创建三视图-

SetSwView=SwDraw.CreateDrawViewFromModelView2（SwChildComp.GetPathName,"

*前视"

0.07954434782609,0.09376565217391,0）

viewnameis:

SwView.Name

ViewName=SwView.Name

SwViewnameis:

viewname

SwDraw.Extension.SelectByID2ViewName,"

DRAWINGVIEW"

0,0,0,False,0,Nothing,0

SwDraw.ActivateViewViewName

SetSwView=SwDraw.CreateUnfoldedViewAt3（0.2224917391304,0.09376565217391,0,0）'

上视

SwDraw.ClearSelection2True

SetSwView=SwDraw.Creat