ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
PWPathum Wijesooriya04/08/2020

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