AnsweredAssumed Answered

My macro works on 'Parts' but not on 'Assemblys' (SW2017)

Question asked by Mark Kamphuis on May 14, 2020
Latest reply on May 15, 2020 by Deepak Gupta

Hello, y'all!

 

I'm a beginner when it comes to coding. For my job I got a task which I have to do over 400 times. I thought: hey let's write a macro for it. So I did, and it works fine for 'Parts'. And yes like you can already guess, it doesn't work on assemblies. I've tried a lot but without any luck, unfortunately. Underneath I will explain how my macro works:

  1. I have opened a part or assembly;
  2. It will look if there is a drawing;
    1. If not, it will end the macro.
    2. If there is a drawing the macro will open it.
  3. When we opened the drawing it will go back to the referenced file (part or drawing) of the drawing (This is where my macro stops working for the 'Assembly' extensions, for 'parts' it works already perfectly)
    1. I can't figure out why it works with parts but doesn't work with assemblies
  4. It will execute a 'save as' function (with dialogue box)
  5. It will save it as the new name and it will open the drawing again
  6. Then it will save the drawing through a 'save as' function (again with a dialogue box)
    1. Maybe someone knows how I can use my entered filename from step 4. to save with this name the drawing as well. Would be awesome!
  7. It will close the drawing.

 

Can someone help me with this problems (Bold black letters)?  I would really appreciate it! Thanks in advance!

 

Dim swApp As Object
Dim DrawingDoc As Object
Dim Sheet As Object
Dim sFileName As String
Dim longstatus As Long
Dim longwarnings As Long
Dim nErrors As Long
Dim nWarnings As Long
Dim nFileSaveAs As Boolean
Dim bRet As Boolean

Dim swModel As SldWorks.ModelDoc2
Dim swView As SldWorks.View

Const swDocDRAWING = 3

 

Sub MKAmain()

'**********************************************************************************************
' Open drawing

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

Set fso = CreateObject("Scripting.FileSystemObject")
sFileName = Left$(Part.GetPathName, (Len(Part.GetPathName) - 6)) & "SLDDRW"

If fso.FileExists(sFileName) Then
Set Part = swApp.OpenDoc(sFileName, swDocDRAWING)
Else: MsgBox ("Drawing does not exist.")
Exit Sub
End If

'**********************************************************************************************
' Going Back To Part/Assembly

swApp.ActivateDoc2 sDocFileName, True, longstatus
Set Part = swApp.ActiveDoc

'**********************************************************************************************
' Save As New File Name By Using 'Save As Dialog'

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swModel.Extension.RunCommand swCommands_SaveAs, Empty

'**********************************************************************************************
' Back To Our Drawing

Set swApp = Application.SldWorks
swApp.ActivateDoc2 sFileName, False, longstatus
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 sFileName, False, longstatus
Set Part = swApp.ActiveDoc

'**********************************************************************************************
' Saves the Drawing

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
swModel.Extension.RunCommand swCommands_SaveAs, Empty


'**********************************************************************************************
' Sluit Tekening
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
bRet = swModel.ForceRebuild3(False)
bRet = swModel.Save3(swSaveAsOptions_Silent, nErrors, nWarnings)
swApp.CloseDoc (swModel.GetPathName)

End Sub

Outcomes