AnsweredAssumed Answered

Macro help

Question asked by Daniel Ferrucci-Herzberg on Jul 13, 2020
Latest reply on Jul 14, 2020 by Deepak Gupta

Hi all, looking for help debugging this macro which should make my job a lot easier. It's not my work, and I don't know who made it, but I'll try to help as best I can. The code below should take a part using our standard numbering scheme (basically the part number is always the same as the drawing number, unless it's a separable mechanical assembly, then the part starts with 600- and the drawing starts with 610-), and export a Parasolid and an isometric .png image, then open the associated drawing and export a PDF, all with the current revision appended to the filename.

 

It's getting caught on getting the revision, and I can't figure out why (I'm not a macro guy).

 

Any suggestions would be helpful.

 

' ******************************************************************************
' Rev 5 Created 18 May 2018
' Change Log:
' Updated to work from drawing or model
' Updated to pull rev from drawing
' ******************************************************************************
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim config As SldWorks.Configuration
Dim longstatus As Long
Dim longwarnings As Long

Dim PartNumberExt As String
Dim PartNumber As String
Dim FilePath As String
Dim NumberSize As Long
Dim swModelDocExt As ModelDocExtension
Dim FileType As String
Dim FileNubmer As String
Dim StoragePath As String
Dim Errors As Long
Dim Silent As Boolean
Dim Revision As String
Dim RevStore As String
Dim ResRevStore As String
Dim swCustProp As CustomPropertyManager
Dim bool As Boolean
Dim AltPartNumber As String



Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set config = swModel.GetActiveConfiguration

' Get Part Number and file path
FilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
PartNumberExt = Right(swModel.GetPathName, (Len(swModel.GetPathName) - InStrRev(swModel.GetPathName, "\")))
NumberSize = Strings.Len(PartNumberExt)
PartNumber = Strings.Left(PartNumberExt, NumberSize - 7)

' Break out File Type and File Number (Will not work for non-standard part numbers)
FileType = Strings.Left(PartNumber, 3)
FileNumber = Strings.Right(PartNumber, 5)

'Store model part number before checking for alternate drawing part numbers.
AltPartNumber = PartNumber

'Set Drawing Number based on Drawing Type
If FileType = 600 Then
PartNumber = "610-" & FileNumber
End If

' Open Drawing
Set swModel = swApp.ActivateDoc2(FilePath & PartNumber & ".slddrw", Silent, Errors)
Dim swDrawing As Object
Set swDrawing = swModel

'Get Revision
Set swCustProp = swModel.Extension.CustomPropertyManager("Revision")
bool = swCustProp.Get4("Revision", False, RevStore, ResRevStore)
'RevStore = swDrawing.CustomInfo("Revision")

' Zoom To Fit
swModel.ViewZoomtofit2

' Get Username to locate local storage folder
'StoragePath = Environ("UserProfile")

' Save As PDF (Edit File path to your local storage folder)
longstatus = swModel.SaveAs3(StoragePath & "W:\Shared With Me\Shared Documents-Goddard\Dan H ECOs" & PartNumber & "_R" & RevStore & ".PDF", 0, 0)

' Open (Allowing for assm versus part. Probably a better way but this works.
If (FileType = 400) Then
Set swModel = swApp.ActivateDoc2(FilePath & AltPartNumber & ".sldasm", Silent, Errors)
ElseIf (FileType = 600) Then
Set swModel = swApp.ActivateDoc2(FilePath & AltPartNumber & ".sldasm", Silent, Errors)
ElseIf (FileType = 700) Then
Set swModel = swApp.ActivateDoc2(FilePath & AltPartNumber & ".sldasm", Silent, Errors)
Else
Set swModel = swApp.ActivateDoc2(FilePath & AltPartNumber & ".sldprt", Silent, Errors)
End If

Set swDrawing = swModel

' Orient to ISO
swModel.ShowNamedView2 "*Isometric", 7
swModel.ViewZoomtofit2

' Save As PNG
longstatus = swModel.SaveAs3(StoragePath & "W:\Shared With Me\Shared Documents-Goddard\Dan H ECOs" & PartNumber & "_R" & RevStore & ".PNG", 0, 0)

' Save As x_t
longstatus = swModel.SaveAs3(StoragePath & "W:\Shared With Me\Shared Documents-Goddard\Dan H ECOs" & PartNumber & "_R" & RevStore & ".x_t", 0, 0)


'Close Model
swApp.QuitDoc (PartNumber & ".SLDPRT")

' Close Drawing - This does not work. Not sure why.
swApp.QuitDoc (PartNumber & ".SLDDRW")

End Sub

Outcomes