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

    Export Part as DWG/DXF Macro

    Sam King

      I am trying to export a face (with multiple holes of varying types) as a DXF file for our waterjet. I'm also creating/saving the DXF in a new folder named "Waterjet Files" In my code I select all the appropriate faces I want to export.  You can see in the pictures, that the counterbored/countersunk surfaces are not selected.  For some reason, when I export the DXF it is including those surfaces in the DXF file.  Does anybody know why it is doing this? (I'm also pretty new at programming so some of the code may not be that efficient, any suggestions for improvement would be greatly appreciated)

       

      Here is my code:


      Option Explicit
      Sub SelectFrontFace()


          Dim swApp                               As SldWorks.SldWorks
          Dim swMathUtility                     As SldWorks.MathUtility
          Dim swRefPlaneTransform     As SldWorks.MathTransform
          Dim swNormalVector          As SldWorks.MathVector
          Dim faceNormalVector        As SldWorks.MathVector
          Dim swNormalVectorRefPlane  As SldWorks.MathVector
          Dim swParallelCheck         As SldWorks.MathVector
          Dim swOriginPoint           As SldWorks.MathPoint
          Dim swOriginPointRefPlane   As SldWorks.MathPoint
          Dim swModel                 As SldWorks.ModelDoc2
          Dim swPart                  As SldWorks.PartDoc
          Dim swBody                  As SldWorks.Body2
          Dim swSelMgr                As SldWorks.SelectionMgr
          Dim swFeature               As SldWorks.Feature
          Dim subFeature              As SldWorks.Feature
          Dim NextFeature             As SldWorks.Feature
          Dim swPlane                 As SldWorks.Feature
          Dim PlaneFeature            As SldWorks.Feature
          Dim mySurface               As SldWorks.Surface
          Dim FeatureData             As SldWorks.WizardHoleFeatureData2
          Dim refPlane                As SldWorks.refPlane
          Dim myFace                  As SldWorks.Face2
          Dim myEdge                  As SldWorks.Edge
          Dim goodEdge                As SldWorks.Edge
          Dim swSketch                As SldWorks.Sketch
          Dim HoleDim                 As SldWorks.Dimension
          Dim vConfNameArr            As Variant
          Dim vDimVal                 As Variant
          Dim HoleSize                As Variant
          Dim varAlignment            As Variant
          Dim varViews                As Variant
          Dim swFaceVar               As Variant
          Dim vEdges                  As Variant
          Dim vP1                     As Variant
          Dim vP2                     As Variant
          Dim swBodyVar               As Variant
          Dim planeParams             As Variant
          Dim vFaceNorm               As Variant
          Dim vPointData              As Variant
          Dim vVectorData             As Variant
          Dim FeatureCount            As Long
          Dim FastenerType            As Long
          Dim swNameSize              As Long
          Dim swPathSize              As Long
          Dim FeatureType             As String
          Dim swConfigName            As String
          Dim NextFeatureType         As String
          Dim sketchName              As String
          Dim FastenerSize            As String
          Dim swModelName             As String
          Dim swPathName              As String
          Dim dataViews(0)            As String
          Dim swFileName              As String
          Dim swFileNameNoExtension   As String
          Dim swPathNoExtension       As String
          Dim swNewFilePath           As String
          Dim swNewFileName           As String
          Dim refPlaneName            As String
          Dim dataAlignment(11)       As Double
          Dim dDist                   As Double
          Dim aPointData(2)           As Double
          Dim aVectorData(2)          As Double
          Dim VectorLength            As Double
          Dim i                       As Integer
          Dim j                       As Integer
          Dim faceCount               As Integer
          Dim edgeCount               As Integer
          Dim HoleType                As Integer
          Dim MyPlane                 As Object
          Dim FrontPlane              As Object
          Dim boolstatus              As Boolean
          Dim bShowConfig             As Boolean
          Dim bCoin                   As Boolean
          Dim surf                    As Boolean
         
          Set swApp = Application.SldWorks
          Set swMathUtility = swApp.GetMathUtility
          Set swModel = swApp.ActiveDoc
          Set swPart = swModel
          Set swFeature = swPart.FirstFeature
          Set swSelMgr = swModel.SelectionManager
          swModel.ClearSelection2 True
         
          vConfNameArr = swModel.GetConfigurationNames
          If UBound(vConfNameArr) > 0 Then
                  swConfigName = vConfNameArr(1)
              ElseIf UBound(vConfNameArr) > 1 Then
                  MsgBox ("Too Many Configurations")
              Exit Sub
              Else
                  swConfigName = "Default"
          End If
          bShowConfig = swModel.ShowConfiguration2(swConfigName)
         
          Set PlaneFeature = swPart.FeatureByName("FRONT")
          refPlaneName = PlaneFeature.Name
          Set refPlane = PlaneFeature.GetSpecificFeature2
          Set swRefPlaneTransform = refPlane.Transform
          aPointData(0) = 0#
          aPointData(1) = 0#
          aPointData(2) = 1#
          vPointData = aPointData
          Set swOriginPoint = swMathUtility.CreatePoint(vPointData)
          Set swOriginPointRefPlane = swOriginPoint.MultiplyTransform(swRefPlaneTransform)
          vPointData = swOriginPointRefPlane.ArrayData
          aVectorData(0) = 0#
          aVectorData(1) = 0#
          aVectorData(2) = 1#
          vVectorData = aVectorData
          Set swNormalVector = swMathUtility.CreateVector(vVectorData)
          Set swNormalVectorRefPlane = swNormalVector.MultiplyTransform(swRefPlaneTransform)
          vVectorData = swNormalVectorRefPlane.ArrayData
         
          boolstatus = swPart.Extension.SelectByID2("FRONT", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
          Set MyPlane = swSelMgr.GetSelectedObject6(1, -1)
         
          swBodyVar = swPart.GetBodies2(swSolidBody, False)
          Set swBody = swBodyVar(0)

          swFaceVar = swBody.GetFaces
          For faceCount = 0 To UBound(swFaceVar)
              Set myFace = swFaceVar(faceCount)
              bCoin = True
              vEdges = myFace.GetEdges
              dDist = swModel.ClosestDistance(MyPlane, myFace, vP1, vP2)
             
                  If dDist > 0 Then
                      bCoin = False
                  End If
              Set mySurface = myFace.GetSurface
              surf = mySurface.IsPlane
              planeParams = mySurface.planeParams
              vFaceNorm = myFace.Normal
              Set faceNormalVector = swMathUtility.CreateVector(vFaceNorm)
              Set swParallelCheck = swNormalVectorRefPlane.Cross(faceNormalVector)
              VectorLength = swParallelCheck.GetLength
              If VectorLength = 0 Then
                  If surf Then
                      If bCoin Then
                          myFace.Select True
                      End If
                  End If
              End If
          Next faceCount

          swModelName = swModel.GetPathName
          swPathName = swModel.GetPathName
         
          swPathSize = Strings.Len(swPathName)
          swPathNoExtension = Strings.Left(swPathName, swPathSize - 17)
          swNewFilePath = swPathNoExtension & "Waterjet Files\"
          If Len(Dir(swNewFilePath, vbDirectory)) = 0 Then
              MkDir (swNewFilePath)
          End If
         
          swFileName = swModel.GetTitle
          swNameSize = Strings.Len(swFileName)
          swNewFileName = Strings.Left(swFileName, swNameSize - 6)

          swPathName = Left(swPathName, InStrRev(swPathName, "\"))
          swPathName = swNewFilePath & swNewFileName & "dxf"
         
          dataAlignment(0) = 0#
          dataAlignment(1) = 0#
          dataAlignment(2) = 0#
          dataAlignment(3) = 1#
          dataAlignment(4) = 0#
          dataAlignment(5) = 0#
          dataAlignment(6) = 0#
          dataAlignment(7) = 0#
          dataAlignment(8) = 0#
          dataAlignment(9) = 0#
          dataAlignment(10) = 1#
          dataAlignment(11) = 0#

          varAlignment = dataAlignment
          dataViews(0) = ""
          varViews = dataViews
         
          swPart.ExportToDWG swPathName, swModelName, 2, True, varAlignment, False, False, 0, Null
      End Sub

       


        • Re: Export Part as DWG/DXF Macro
          Gustavo Oliveira

          Try this:

           

          Option Explicit

          Sub SelectFrontFace()

           

           

              Dim swApp                               As SldWorks.SldWorks

              Dim swMathUtility                     As SldWorks.MathUtility

              Dim swRefPlaneTransform     As SldWorks.MathTransform

              Dim swNormalVector          As SldWorks.MathVector

              Dim faceNormalVector        As SldWorks.MathVector

              Dim swNormalVectorRefPlane  As SldWorks.MathVector

              Dim swParallelCheck         As SldWorks.MathVector

              Dim swOriginPoint           As SldWorks.MathPoint

              Dim swOriginPointRefPlane   As SldWorks.MathPoint

              Dim swModel                 As SldWorks.ModelDoc2

              Dim swPart                  As SldWorks.PartDoc

              Dim swBody                  As SldWorks.Body2

              Dim swSelMgr                As SldWorks.SelectionMgr

              Dim swFeature               As SldWorks.Feature

              Dim subFeature              As SldWorks.Feature

              Dim NextFeature             As SldWorks.Feature

              Dim swPlane                 As SldWorks.Feature

              Dim PlaneFeature            As SldWorks.Feature

              Dim mySurface               As SldWorks.Surface

              Dim FeatureData             As SldWorks.WizardHoleFeatureData2

              Dim refPlane                As SldWorks.refPlane

              Dim myFace                  As SldWorks.Face2

              Dim myEdge                  As SldWorks.Edge

              Dim goodEdge                As SldWorks.Edge

              Dim swSketch                As SldWorks.Sketch

              Dim HoleDim                 As SldWorks.Dimension

              Dim vConfNameArr            As Variant

              Dim vDimVal                 As Variant

              Dim HoleSize                As Variant

              Dim varAlignment            As Variant

              Dim varViews                As Variant

              Dim swFaceVar               As Variant

              Dim vEdges                  As Variant

              Dim vP1                     As Variant

              Dim vP2                     As Variant

              Dim swBodyVar               As Variant

              Dim planeParams             As Variant

              Dim vFaceNorm               As Variant

              Dim vPointData              As Variant

              Dim vVectorData             As Variant

              Dim FeatureCount            As Long

              Dim FastenerType            As Long

              Dim swNameSize              As Long

              Dim swPathSize              As Long

              Dim FeatureType             As String

              Dim swConfigName            As String

              Dim NextFeatureType         As String

              Dim sketchName              As String

              Dim FastenerSize            As String

              Dim swModelName             As String

              Dim swPathName              As String

              Dim dataViews(0)            As String

              Dim swFileName              As String

              Dim swFileNameNoExtension   As String

              Dim swPathNoExtension       As String

              Dim swNewFilePath           As String

              Dim swNewFileName           As String

              Dim refPlaneName            As String

              Dim dataAlignment(11)       As Double

              Dim dDist                   As Double

              Dim aPointData(2)           As Double

              Dim aVectorData(2)          As Double

              Dim VectorLength            As Double

              Dim i                       As Integer

              Dim j                       As Integer

              Dim faceCount               As Integer

              Dim edgeCount               As Integer

              Dim HoleType                As Integer

              Dim MyPlane                 As Object

              Dim FrontPlane              As Object

              Dim boolstatus              As Boolean

              Dim bShowConfig             As Boolean

              Dim bCoin                   As Boolean

              Dim surf                    As Boolean

            

              Set swApp = Application.SldWorks

              Set swMathUtility = swApp.GetMathUtility

              Set swModel = swApp.ActiveDoc

              Set swPart = swModel

              Set swFeature = swPart.FirstFeature

              Set swSelMgr = swModel.SelectionManager

              swModel.ClearSelection2 True

            

              vConfNameArr = swModel.GetConfigurationNames

              If UBound(vConfNameArr) > 0 Then

                      swConfigName = vConfNameArr(1)

                  ElseIf UBound(vConfNameArr) > 1 Then

                      MsgBox ("Too Many Configurations")

                  Exit Sub

                  Else

                      swConfigName = "Default"

              End If

              bShowConfig = swModel.ShowConfiguration2(swConfigName)

            

              Set PlaneFeature = swPart.FeatureByName("FRONT")

              refPlaneName = PlaneFeature.Name

              Set refPlane = PlaneFeature.GetSpecificFeature2

              Set swRefPlaneTransform = refPlane.Transform

              aPointData(0) = 0#

              aPointData(1) = 0#

              aPointData(2) = 1#

              vPointData = aPointData

              Set swOriginPoint = swMathUtility.CreatePoint(vPointData)

              Set swOriginPointRefPlane = swOriginPoint.MultiplyTransform(swRefPlaneTransform)

              vPointData = swOriginPointRefPlane.ArrayData

              aVectorData(0) = 0#

              aVectorData(1) = 0#

              aVectorData(2) = 1#

              vVectorData = aVectorData

              Set swNormalVector = swMathUtility.CreateVector(vVectorData)

              Set swNormalVectorRefPlane = swNormalVector.MultiplyTransform(swRefPlaneTransform)

              vVectorData = swNormalVectorRefPlane.ArrayData

            

              boolstatus = swPart.Extension.SelectByID2("FRONT", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

              Set MyPlane = swSelMgr.GetSelectedObject6(1, -1)

            

              swModel.ClearSelection2 True 'Add this code to clear all selection

             

              swBodyVar = swPart.GetBodies2(swSolidBody, False)

              Set swBody = swBodyVar(0)

           

              swFaceVar = swBody.GetFaces

              For faceCount = 0 To UBound(swFaceVar)

                  Set myFace = swFaceVar(faceCount)

                  bCoin = True

                  vEdges = myFace.GetEdges

                  dDist = swModel.ClosestDistance(MyPlane, myFace, vP1, vP2)

                      If dDist > 0 Then

                          bCoin = False

                      End If

                  Set mySurface = myFace.GetSurface

                  surf = mySurface.IsPlane

                  planeParams = mySurface.planeParams

                  vFaceNorm = myFace.Normal

                  Set faceNormalVector = swMathUtility.CreateVector(vFaceNorm)

                  Set swParallelCheck = swNormalVectorRefPlane.Cross(faceNormalVector)

                  VectorLength = swParallelCheck.GetLength

                  If VectorLength = 0 Then

                      If surf Then

                          If bCoin Then

                              myFace.Select True

                          End If

                      End If

                  End If

              Next faceCount

           

              swModelName = swModel.GetPathName

              swPathName = swModel.GetPathName

            

              swPathSize = Strings.Len(swPathName)

              swPathNoExtension = Strings.Left(swPathName, swPathSize - 17)

              swNewFilePath = swPathNoExtension & "Waterjet Files\"

              If Len(Dir(swNewFilePath, vbDirectory)) = 0 Then

                  MkDir (swNewFilePath)

              End If

            

              swFileName = swModel.GetTitle

              swNameSize = Strings.Len(swFileName)

              swNewFileName = Strings.Left(swFileName, swNameSize - 6)

           

              swPathName = Left(swPathName, InStrRev(swPathName, "\"))

              swPathName = swNewFilePath & swNewFileName & "dxf"

            

             If Dir(swPathName) <> "" Then Kill swPathName 'Add this code to delete the file if it already exists

            

              dataAlignment(0) = 0#

              dataAlignment(1) = 0#

              dataAlignment(2) = 0#

              dataAlignment(3) = 1#

              dataAlignment(4) = 0#

              dataAlignment(5) = 0#

              dataAlignment(6) = 0#

              dataAlignment(7) = 0#

              dataAlignment(8) = 0#

              dataAlignment(9) = 0#

              dataAlignment(10) = 1#

              dataAlignment(11) = 0#

           

              varAlignment = dataAlignment

              dataViews(0) = ""

              varViews = dataViews

             

              swPart.ExportToDWG swPathName, swModelName, 2, True, varAlignment, False, False, 0, Null

             

              swModel.ClearSelection2 True 'Add this code to clear all selection

             

          End Sub