×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Macro to automatically send all currently open parts to Drawing

Macro to automatically send all currently open parts to Drawing

Macro to automatically send all currently open parts to Drawing

(OP)
I have been trying to find a way of sending all currently open parts in Solidworks to a the same drawing (perhaps with a 3 views of each part). I have had some success with the following macro found to send all the parts of the currently open assembly to drawing as flat pattern views. Can anyone assist with modifying the code?

Thanks.


CODE -->

Dim swApp As Object
Sub main()
Dim Part As Object
Dim SelMgr As Object
Dim swView As String
Dim swType As String
Dim swFileName As String
Dim swFilePath As String
Dim swParts(0 To 100) As String
Dim boolstatus As Boolean
Dim Feature As Object
Dim Child   As Object
Dim ModDoc As Object
Dim i As Integer
Dim j As Integer
Dim Children    As Variant
Dim InfoText As String
Dim swModel As Object
Dim TopAssy As String
Dim longstatus As Long, longwarnings As Long
Dim PosX As Double, PosY As Double

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
TopAssy = swModel.GetPathName
swType = swModel.GetType
If swType = swDocASSEMBLY Then

Set ModelDoc2 = swApp.ActiveDoc
Set Configuration = ModelDoc2.GetActiveConfiguration
Set Component2 = Configuration.GetRootComponent
Set ModDoc = Component2.GetModelDoc
InfoText = ""

Children = Component2.GetChildren()
ChildCount = UBound(Children) + 1

i = 0

Do While i <> ChildCount
Set Component2 = Children(i)

Set ModDoc = Component2.GetModelDoc
swFileName = Component2.Name2
swFilePath = Component2.GetPathName

 InfoText = InfoText & "Item " & i & swFilePath & " <" & vbNewLine

swParts(i) = swFilePath

i = i + 1
Loop

MsgBox InfoText, vbOKOnly

i = 0
Do While i <> ChildCount

swFilePath = swParts(i)
'  MsgBox ("opening: " & swFilePath)
Set Part = swApp.OpenDoc6(swFilePath, 1, 0, "", longstatus, longwarnings)
swApp.ActiveDoc.ActiveView.FrameLeft = 0
swApp.ActiveDoc.ActiveView.FrameTop = 0
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
Set Part = swApp.ActivateDoc2(swFilePath, False, longstatus)

        If Part Is Nothing Then
            Call MsgBox("Unable to open document!", vbExclamation, "Line3")  ' Display error message
        End If
i = i + 1
Loop

Set Part = swApp.ActivateDoc2(TopAssy, False, longstatus)

    sTemplateName = "\\artlfile01\Departmental\Fabrication\TRANSFERRED DATA\Department Documents\Templates & Macro's\Prototype Templates\Blank 1000mm x1000mm.DRWDOT"
    Set swDrawing = swApp.NewDocument(sTemplateName, swDwgPaperAsize, 0#, 0#)

' display sheet format
Set swNewSheet = swDrawing.GetCurrentSheet
swNewSheet.SheetFormatVisible = False
swDrawing.EditSheet

i = 0

Do While i <> ChildCount

swView = swParts(i)
'MsgBox ("creating view: " & swView)

PosX = 0.3 + (0.2 * i)
PosY = 0.3 + (0.02 * i)
'Create view
DrawView = swDrawing.CreateFlatPatternViewFromModelView(swView, "*Top", PosX, PosY, 0)

'set scale
boolstatus = swNewSheet.SetScale(1, 1, True, True)

i = i + 1
Loop

End If

If swType = swDocPART Then
MsgBox ("Its a part")
End If
Set swApp = Application.SldWorks
End Sub 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources