Wayyyyyyyyyyyyyy before you add the sheets:
- Using SldWorks.OpenDoc method, open the assembly inside a ModelDoc2
- Define an AssemblyDoc object inside which you cast the ModelDoc2 object
- Use the method AssemblyDoc.GetComponents to get a variant of component2.
- Define a collection object and call it (for example) ComponentsFilePaths
- Traverse the component2 variant and use the collection:add method to add component2.GetPathName (Now you have a collection of file paths!)
- Close the ModelDoc2 of the assembly using ModelDoc2.Close
- Remove duplicates
Back to the drawing doc now:
- Traverse the ComponentsFilePaths collection, add new sheet then use swDraw.Create3rdAngleViews2(Collection(i)) to insert the views
- When you hear traversing, often times, people are refering to for each loops.
Example: Traversing a component2 variant called Components
Dim Obj For Each Obj In Components Dim Comp As Component2 Set Comp = Obj 'Doc stuff here Next Obj
- When you're inserting sheets, you might want to use the filename as the sheet's name.
If the filename is not meaningful, consider creating a class with two fields: name and filepath. You add whatever customproperty from the component2 as the name and the file path as seen before. After that you add the class objects to the collection. If you choose to use the filename. Use the split function to get the filename from the path.
Dim FilePath As String FilePath = "C:\File.Exension" Dim FileName As String FileName = Split(Split(FilePath,"\")[Ubound(Split(FilePath,"\"))],".")
Thank you very much for your reply. I tried out as you suggested and I think I have managed to get what I want, almost. So I would like to ask how to eliminate duplicates, as the macro creates drawing views for each component and finally how do I disable the creation of views for the subassemblies?
You're doing the right way! You're almost there!
Instead of removing duplicates, prevent duplicates from being added simply by checking if file path already exist in the collection before adding?
Dim Exist as Boolean For i = 0 To ComponentsFilePath.Count If ComponentsFilePath(i) = swComp.GetPathName Then Exist = True Exit For End If Next i If Exist = False Then ComponentsFilePaths.Add(swComp.GetPathName) End If
I've written this off the top of my head. So you can improve it.
Instead of traversing the vcomp for the sheet creation, traverse the filepath collection (because vcomp might have duplicates eg: one part figuring in different sub-assemblies)
Great, I'll give it a try. And something else, if you have time, do you have any idea how to prevent sheets memorandum from getting named with the same name? For example one component is named "4_Upper_Link", all the sheets (in the field DWG No) are named like this. Would be better if each sheet's DWG No field is named after the name of the component.
If I understood correctly. You need to edit the annotation inside the sheet template title block and link it to the model doc built in name property.
Hope this illustration is useful (The language is french is that interests you ):
Kindly post your full working code so the community can benefit from it.
You are right, I deleted the code prior to editing my last comment, as it was not fully functional.
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swDraw As SldWorks.DrawingDoc
Dim swComp As SldWorks.Component2
Dim PathCollection As collection
Dim vComps As Variant
Dim SheetName As Variant
Dim AssyName As String
Dim TemplateName As String
Dim i As Integer
Dim retval As Boolean
Dim errors As Long
Dim warnings As Long
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swAssy = swModel
Set PathCollection = New collection
AssyName = "C:\MyAssemblies\Test_Assembly.SLDASM"
Set swAssy = swApp.OpenDoc6(AssyName, swDocASSEMBLY, 0, "", errors, warnings)
TemplateName = "C:\MyTemplates\Drawing.DRWDOT"
Set swDraw = swApp.NewDocument(TemplateName, swDwgPaperA3size, 0, 0)
vComps = swAssy.GetComponents(False)
For i = 1 To UBound(vComps)
Set swComp = vComps(i)
For i = 1 To PathCollection.Count
SheetName = "Part" & i
retval = swDraw.NewSheet3(SheetName, swDwgPaperA3size, swDwgTemplateA3size, 1, 2, False, "", 0, 0, "")
retval = swDraw.Create3rdAngleViews2(PathCollection(i))
I have read that when using a collection it will store only unique values. If this is true then there is no need for extra code to prevent the duplicates from adding to the collection, but I am not sure how to properly use the collection for this purpose. I would appreciate any idea. Also I haven't figured out how to prevent the duplicates with if statements as you proposed.
That's not precisely true. Collections store a (key,value) pair where the value can be the same across the collections, the key need to be unique. When you don't specify the key, VBA will take care of it. This screenshot of this test sub will illustrate my point.
- Dim Exist as Boolean 'Default value is false
- ' Look if swComp.GetPathName exist in the collection
- For i = 0 To ComponentsFilePath.Count - 1
- If ComponentsFilePath(i) = swComp.GetPathName Then
- ' Set Exist to true since the file path exists and break off the for loop
Exist = True
- Exit For
- End If
- Next i
- If Exist = False Then 'This mean that the swComp.GetPathName does not exist in the collection
- End If
To prevent the creation of subassemblies sheets, simply check if the extension in the filepathname is not that of an assembly before adding it to the collection. Use the split function to split the pathname into an array with "." being the separator. The utmost element of the array is the extension which should not be ASM or SLDASM.
Another cooler option (but consumes memory and time) is to use Component2.GetModelDoc and cast into a ModelDoc2 and use GetType to get the type of the model.
GetType returns an integer represents the type of the model doc with 1 representing part documents.