3 Replies Latest reply on Feb 6, 2014 12:59 PM by Sam King

    Macro - Select Front Face and Save as DXF in New Folder

    Sam King

      I've been working on a macro that will select the front face of a part and save it as a DXF file.  We currently have to do this one file at a time so we can send the files to our manufacturing department.  I'm pretty new at API so I've been piecing together parts from other examples I have found in the forum.


      When I run the macro, it doesn't seem to be saving the file as I requested.  ANy Idea what's going on?


      Here is the code


      Option Explicit

      Sub main()
      'Get the front face variables
      Dim swApp As SldWorks.SldWorks
      Dim swDoc As SldWorks.ModelDoc2
      Dim swPartDoc As SldWorks.PartDoc
      Dim swBody As SldWorks.Body2
      Dim swBodyVar As Variant
      Dim swFaceVar As Variant
      Dim bodyCount As Long
      Dim swSelMgr As SldWorks.SelectionMgr
      Dim MyPlane As Object
      Dim myFace As SldWorks.Face2
      Dim faceCount As Integer
      Dim edgeCount As Integer
      Dim dDist As Double
      Dim vP1 As Variant
      Dim vP2 As Variant
      Dim vEdges As Variant
      Dim bCoin As Boolean
      Dim boolstatus As Boolean
      Dim myEdge As SldWorks.Edge
      'Save As DXF Variables
      Dim FilePath As String
      Dim PathSize As Long
      Dim PathNoExtension As String
      Dim NewFilePath As String
      Dim FileName As String
      Dim NameSize As Long
      Dim NewFileName As String
      Dim NameNoExtension As String

      'Get Face Code

      Set swApp = Application.SldWorks
      Set swDoc = swApp.ActiveDoc
      Set swPartDoc = swDoc
      Set swSelMgr = swDoc.SelectionManager
      swDoc.ClearSelection2 True
      boolstatus = swPartDoc.Extension.SelectByID2("FRONT", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
      If swSelMgr.GetSelectedObjectCount2(-1) <> 1 Then
          Exit Sub
      End If
      Set MyPlane = swSelMgr.GetSelectedObject6(1, -1)
      swDoc.ClearSelection2 True
      swBodyVar = swPartDoc.GetBodies2(swSolidBody, False)
      bodyCount = 0
      For bodyCount = 0 To UBound(swBodyVar)
          Set swBody = swBodyVar(bodyCount)
          swFaceVar = swBody.GetFaces
          For faceCount = 0 To UBound(swFaceVar)
              Set myFace = swFaceVar(faceCount)
              bCoin = True
              vEdges = myFace.GetEdges
              For edgeCount = 0 To UBound(vEdges)
                  Set myEdge = vEdges(edgeCount)
                  dDist = swDoc.ClosestDistance(MyPlane, myEdge, vP1, vP2)
                  If dDist > 0 Then
                      bCoin = False
                      Exit For
                  End If
              Next edgeCount
              If bCoin Then
                  myFace.Select True
              End If
          Next faceCount
      Next bodyCount

      'Save DXF Code

      FilePath = swDoc.GetPathName
      PathSize = Strings.Len(FilePath)
      FileName = swDoc.GetTitle
      NameSize = Strings.Len(FileName)

      PathNoExtension = Strings.Left(FilePath, PathSize - 17)
      NameNoExtension = Strings.Left(FileName, NameSize - 6)

      NewFileName = NameNoExtension & ".dxf"
      NewFilePath = PathNoExtension & "Waterjet Files\"

      swDoc.SaveAs (NewFilePath & NewFileName)


      End Sub