×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

API question

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

RE: API question

By looking over your code, I assume your macro is having problems at the Part.SaveAs4 statement.  There are several ways you can do what you want.  My favorite is to use the VB replace function.  I would change

CODE

Part.SaveAs4 MyFile.Path & ".slddrw", 0, False, False
     to

CODE

Part.SaveAs4 Replace(MyFile.Path, ".sldprt", "", 1, , vbTextCompare) & ".slddrw", 0, False, False

SA

RE: API question

(OP)
Solidair
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


============================================================

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources