API question
API question
(OP)
I created this macro to create a flat pattern of a sheet metal part in a 1/1 scale with nothing added for our CNC programmer. Anyways I used the microsoft scripting runtime to get a collection but i cant figure out how to stop the original file extension (.SLDPRT) from being recorded into the file name. So I was hoping someone has been hear before and has some tips. Here is the macro. If you need to use this macro dont forget to turn on your Microsoft Scripting Runtime.
-----------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.DrawingDoc
Dim boolstatus As Boolean
Const MyTemplate As String = "C:\Program Files\SolidWorks\data\templates\Drawing.drwdot"
Dim MyPath As String
Sub main()
Set swApp = Application.SldWorks
MyPath = InputBox("Enter the directory:", _
"NC flat Pattern Creator", "C:\")
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim MyFiles As Scripting.Files
Set MyFiles = fso.GetFolder(MyPath).Files
Dim MyFile As Scripting.File
Dim longerrors As Long
Dim longwarnings As Long
For Each MyFile In MyFiles
'filter on SolidWorks Parts by extension
If UCase(Right(MyFile.Name, 6)) = "SLDPRT" Then
Set Part = swApp.NewDocument(MyTemplate, swDwgPaperAsize, _
0.2794, 0.2159)
swApp.OpenDoc6 MyFile.Path, swDocPART, _
swOpenDocOptions_ReadOnly, "", _
longerrors, longwarnings
'Part.Create3rdAngleViews2 MyFile.Path
Part.CreateFlatPatternViewFromModelView MyFile.Path, "Default", 0.1832751111111, 0.1387937530864, 0
'Part.CreateDrawViewFromModelView MyFile.Path, "*Right", 0.3, 0.1278425588148, 0
'Part.CreateDrawViewFromModelView MyFile.Path, "*Top", 0.1832751111111, 0.4, 0
'Part.CreaterightFromModelView MyFile.Path, "Default", 0.5, 0.5, 0
Dim DrawView As SldWorks.View
Set DrawView = Part.CreateDrawViewFromModelView2 _
(MyFile.Path, "flat pattern", _
0.2219892300099, 0.1639348094768, 0)
Part.ViewDisplayWireframe
End If
Part.ClearSelection2 True
Part.WindowRedraw
'save the drawing
Part.SaveAs4 MyFile.Path & ".slddrw", 0, False, _
False
'close the part and new drawing
swApp.CloseDoc MyFile.Path
swApp.CloseDoc MyFile.Path & ".slddrw"
Next MyFile
End Sub
-----------------------------------------------------------
Thanks in advance
-----------------------------------------------------------
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.DrawingDoc
Dim boolstatus As Boolean
Const MyTemplate As String = "C:\Program Files\SolidWorks\data\templates\Drawing.drwdot"
Dim MyPath As String
Sub main()
Set swApp = Application.SldWorks
MyPath = InputBox("Enter the directory:", _
"NC flat Pattern Creator", "C:\")
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim MyFiles As Scripting.Files
Set MyFiles = fso.GetFolder(MyPath).Files
Dim MyFile As Scripting.File
Dim longerrors As Long
Dim longwarnings As Long
For Each MyFile In MyFiles
'filter on SolidWorks Parts by extension
If UCase(Right(MyFile.Name, 6)) = "SLDPRT" Then
Set Part = swApp.NewDocument(MyTemplate, swDwgPaperAsize, _
0.2794, 0.2159)
swApp.OpenDoc6 MyFile.Path, swDocPART, _
swOpenDocOptions_ReadOnly, "", _
longerrors, longwarnings
'Part.Create3rdAngleViews2 MyFile.Path
Part.CreateFlatPatternViewFromModelView MyFile.Path, "Default", 0.1832751111111, 0.1387937530864, 0
'Part.CreateDrawViewFromModelView MyFile.Path, "*Right", 0.3, 0.1278425588148, 0
'Part.CreateDrawViewFromModelView MyFile.Path, "*Top", 0.1832751111111, 0.4, 0
'Part.CreaterightFromModelView MyFile.Path, "Default", 0.5, 0.5, 0
Dim DrawView As SldWorks.View
Set DrawView = Part.CreateDrawViewFromModelView2 _
(MyFile.Path, "flat pattern", _
0.2219892300099, 0.1639348094768, 0)
Part.ViewDisplayWireframe
End If
Part.ClearSelection2 True
Part.WindowRedraw
'save the drawing
Part.SaveAs4 MyFile.Path & ".slddrw", 0, False, _
False
'close the part and new drawing
swApp.CloseDoc MyFile.Path
swApp.CloseDoc MyFile.Path & ".slddrw"
Next MyFile
End Sub
-----------------------------------------------------------
Thanks in advance






RE: API question
CODE
CODE
SA
RE: API question
I knew you would be the one to pull me out of this bind, I was trying to use the len function with no luck, I do have another new guy question for you and that is if I wanted the drawing view to scale to fit the drawing template one is this possible and two how would I go about doing this. I did find some scale to fit stukk in the API help menu but my feable brain couldn't understand it.
Thanks
Christopher
Here is the final working macro for anyone who works with sheetmetal
============================================================
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.DrawingDoc
Dim boolstatus As Boolean
Const MyTemplate As String = "C:\Program Files\SolidWorks\data\templates\Drawing.drwdot"
Dim MyPath As String
Sub main()
Set swApp = Application.SldWorks
MyPath = InputBox("Enter the directory:", _
"NC flat Pattern Creator", "C:\")
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Dim MyFiles As Scripting.Files
Set MyFiles = fso.GetFolder(MyPath).Files
Dim MyFile As Scripting.File
Dim longerrors As Long
Dim longwarnings As Long
For Each MyFile In MyFiles
'filter on SolidWorks Parts by extension
If UCase(Right(MyFile.Name, 6)) = "SLDPRT" Then
Set Part = swApp.NewDocument(MyTemplate, swDwgPaperAsize, _
0.2794, 0.2159)
swApp.OpenDoc6 MyFile.Path, swDocPART, _
swOpenDocOptions_ReadOnly, "", _
longerrors, longwarnings
'Part.Create3rdAngleViews2 MyFile.Path
Part.CreateFlatPatternViewFromModelView MyFile.Path, "Default", 0.1832751111111, 0.1387937530864, 0
'Part.CreateDrawViewFromModelView MyFile.Path, "*Right", 0.3, 0.1278425588148, 0
'Part.CreateDrawViewFromModelView MyFile.Path, "*Top", 0.1832751111111, 0.4, 0
'Part.CreaterightFromModelView MyFile.Path, "Default", 0.5, 0.5, 0
Dim DrawView As SldWorks.View
Set DrawView = Part.CreateDrawViewFromModelView2 _
(MyFile.Path, "flat pattern", _
0.2219892300099, 0.1639348094768, 0)
Part.ViewDisplayWireframe
End If
Part.ClearSelection2 True
Part.WindowRedraw
'save the drawing
Part.SaveAs2 Replace(MyFile.Path, ".sldprt", "", 1, , vbTextCompare) & ".slddrw", 0, False, False
'Part.SaveAs2 Replace(MyFile.Path, ".sldprt", "", 1, , vbTextCompare), 0, False, False
'close the part and new drawing
swApp.CloseDoc MyFile.Path
swApp.CloseDoc Replace(MyFile.Path, ".sldprt", "", 1, , vbTextCompare) & ".slddrw"
'swApp.CloseDoc MyFile.Path & ".slddrw"
'swApp.CloseDoc MyFile.Path
Next MyFile
End Sub
============================================================