The following macro to make flat pattern form assembly file was working fine and well for me. But after i updated my standard SW license to Professional suddenly it stooped working and gives me an error,
Can anyone please help me on this.
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc2
Set swApp = CreateObject("SldWorks.Application")
Set swmodel = swApp.ActiveDoc
Dim savepath As String
savepath = InputBox("Where do you want to save?")
traverse swApp.ActiveDoc, savepath
End Sub
Function traverse(Pathname As ModelDoc2, savepath As String)
Dim swApp As SldWorks.SldWorks
Dim swComp As SldWorks.Component2
Dim swmodel As SldWorks.ModelDoc2
Dim vChildComp As Variant
Dim swChildComp As SldWorks.Component2
Dim sPadStr As String
Dim i As Long
Dim swRootComp As SldWorks.Component2
Dim swConf As SldWorks.Configuration
Dim swConfMgr As SldWorks.ConfigurationManager
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim longwarnings As Long
Dim assem As String
Dim part1 As String
Dim Foldername As String
Dim PathLength As Variant
Dim Filepath As String
Dim Filename As String
Set swApp = CreateObject("SldWorks.Application")
Set swmodel = Pathname
Set Part = swmodel
Set swConfMgr = swmodel.ConfigurationManager
Set swConf = swConfMgr.ActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)
vChildComp = swRootComp.GetChildren
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)
Set swmodel = swChildComp.GetModelDoc2
If Not swmodel Is Nothing Then
If swmodel.GetType = 2 Then
traverse swmodel, savepath
Else
End If
End If
Next i
End Function
Public Function GetTitle(Path As String)
Dim path1 As Variant
Dim title As String
path1 = Split(Path, "\")
title = path1(UBound(path1))
GetTitle = Left(title, InStr(title, ".") - 1)
End Function
Sub flat(swmodel As SldWorks.ModelDoc2, savepath As String)
Dim swApp As SldWorks.SldWorks
Set swApp = CreateObject("SldWorks.Application")
'Set swmodel = swApp.ActiveDoc
Dim swfeat As SldWorks.Feature
Set swfeat = swmodel.FirstFeature
Dim swflat As SldWorks.Feature
Dim swsubfeat As SldWorks.Feature
'Do Until UCase(swfeat.Name) = "ORIGIN"
' swfeat = swfeat.GetNextFeature
' Loop
Do While Not swfeat Is Nothing
If swfeat.GetTypeName = "FlatPattern" Then
'MsgBox swfeat.Name & " " & swfeat.GetTypeName
Set swflat = swfeat
swfeat.Select (True)
swmodel.EditUnsuppress2
dxf swmodel, savepath
swflat.Select (True)
swmodel.EditSuppress2
End If
Set swfeat = swfeat.GetNextFeature
Loop
' largest
End Sub
Public Function dxf(swmodel As SldWorks.ModelDoc2, savepath As String)
Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc
Dim sModelName As String
Dim sPathName As String
Dim varAlignment As Variant
Dim dataAlignment(11) As Double
Dim varViews As Variant
Dim dataViews(1) As String
Dim options As Long
Set swApp = Application.SldWorks
swApp.ActivateDoc swmodel.GetPathName
If swmodel.GetBendState <> 2 Then
Exit Function
End If
sModelName = swmodel.GetPathName
sPathName = swmodel.GetPathName
sPathName = Left(sPathName, Len(sPathName) - 6)
sPathName = sPathName + "dwg"
Set swPart = swmodel
dataAlignment(0) = 0#
dataAlignment(1) = 0#
dataAlignment(2) = 0#
dataAlignment(3) = 1#
dataAlignment(4) = 0#
dataAlignment(5) = 0#
dataAlignment(6) = 0#
dataAlignment(7) = 1#
dataAlignment(8) = 0#
dataAlignment(9) = 0#
dataAlignment(10) = 0#
dataAlignment(11) = 1#
varAlignment = dataAlignment
dataViews(0) = "*Current"
dataViews(1) = "*Front"
varViews = dataViews
'Export each annotation view to a separate drawing file
'swPart.ExportToDWG sPathName, sModelName, 3, False, varAlignment, False, False, 0, varViews
'Export flat pattern of the sheet metal to a single drawing file
options = 13 '0001101 - include flat pattern geometry, bend lines and sketches
a = swmodel.GetPathName
CText = Split(a, "\")
w = CText(UBound(CText))
w = Left(w, InStr(w, ".") - 1)
Path = savepath & "\" & swmodel.GetTitle & ".dxf"
Debug.Print Path
swPart.ExportToDWG Path, sModelName, 1, True, varAlignment, False, False, options, Null
Debug.Print "Inspect DWG files in " + Left(sPathName, Len(sPathName) - 16)
swApp.CloseDoc (swmodel.GetPathName)
End Function