×
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: View to DXF module

API: View to DXF module

API: View to DXF module

(OP)
It seems there are quite a few threads dealing with exporting DXFs from drawing views, especially when needed for manufacturing. Below is a sample module showing how to parse the geometry from a solidworks view, and how to output your own autocad version 12 compatible dxf file.

This module assumes you are dealing with flat patterns, in any view scale, which need to be 'clean' for toolpathing, etc. While this ripped version ignores linetypes, dimensions, etc, it also ignores the bend lines, datum points, etc which can ruin a machined part.

It also reverses 'flipped' arcs for a true '2d' version of the part. Also some CAM apps dont like the normals reversed in the arcs, so these reversed arcs will 'heal' to  boundary-generating routines. (You ever try drawing a CLOCKWISE 3 point arc in acad?)

To use, import the code as its own module, and set up a sample macro something like this:


Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim Part As ModelDoc2
    Dim dwgDoc As DrawingDoc
    Dim ExportView As view
    Dim DXFName As String
    Dim DXFComment As String
    
    Dim success As Boolean
    
    
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
        
    If Not (Part.GetType = 3) Then Exit Sub ' not a drawing
    Set dwgDoc = Part
   
    Set ExportView = dwgDoc.GetFirstView        ' get the 'sheet view'
    Set ExportView = ExportView.GetNextView     ' get the first view on the sheet
    
    ' we have our view, lets export it to a file
    DXFName = "C:\SW2DXF.dxf"                

    ' embed a comment in the dxf stating the export date, or something
    DXFComment = "Export date: " & Now

    success = ViewToDXF(ExportView, DXFName, DXFComment)
    
    

End Sub

RE: API: View to DXF module

(OP)

' ViewToDXF.bas
' VBA Module to write acad r12 compatable dxfs from a passed SW View


''*****************************************************************************
'These next constants you can set up for personal use, or
' put options in a form, who knows

Const GapTolerance As Double = 0#       ' set this to your units to close up arcs/polylines
Const DecimalPlaces As Integer = 6      ' dxf output trailing decimal places
Const DXFLayerName As String = "SW_Export" ' set this to a VALID layer name
Const ConversionFactor As Double = 39.3700787401575     ' translates meters to inches

Const AcadLineColor As Long = 1: Const AcadPolyColor As Long = 2
Const AcadArcColor As Long = 3: Const AcadCircleColor As Long = 4
''*****************************************************************************

Const Pi As Double = 3.14159265358979
Const Radn  As Double = Pi / 180


' define UDT for entity data - you can grow this easily to add more enity support
Type GeomInfo
   EntityType As Long       ' 1=Line  2=PolyLine  3=Arc
   PointArray() As Variant  ' Entity Geometry data
   Normal As Double         ' 0=regular, -1=reverse from top XY
 End Type
 Dim GeomData() As GeomInfo
 Dim GeomCount As Long       ' Total Number of discreet Entities in drawing



Function ViewToDXF(DwgView As Object, PathSpec As String, DXFComment As String) As Boolean
    
    ' pass this routine a Solidworks viewport,  the full pathname/filespec
    ' of your DXF file, and a comment to embed in the dxf file.

    Dim returncode As Long
    Dim DxfData As String
    
    returncode = ReadView(DwgView)  ' first, get the geomtry from the view
    If returncode <> 0 Then Exit Function ' if a problem, quit here and return false


    ' Now get the dxf data from the geometry we just read
    DxfData = DxfExport(DXFComment)
    
    If DxfData = "" Then Exit Function
    ViewToDXF = WriteDXF(DxfData, PathSpec)
    
   
    
End Function


Function ReadView(swDwgView As Object) As Long
  ' pass the routine the Drawing View Object and it parses geometry out of it
  ' ignores linetypes,layers,splines, colors, you name it.
  ' but also ignores bend lines, datum points, and other non-CAM related stuff
  
  ' returns:    0 = success : GeomData UDT array is seeded
  '            -1 = Spline encountered
  '            -2 = unknown entity encountered
  '            -3 = no geometry in view
  '            -4 = failure in parsing line/polyline geometry
  '            -5 = failure in parsing arc geometry
  
  
    Dim ViewGeom As Variant   ' SafeArray used to Hold all entities returned from SW
    Dim CurrentVariantIndex As Long, TotalVariantIndex As Long
    Dim GeometryType As Integer
    
    Dim PointStorage() As Variant  ' Stores streams of points, dump into variant array
    Dim AllGeometryIsExtracted As Boolean: AllGeometryIsExtracted = False
   
    Erase GeomData(): GeomCount = -1     ' clear our UDT array if calling multiple times
    
    ' Now that View is passed, enum the geometry
      ViewGeom = swDwgView.GetPolylines4()     ' get Line, circle, and arc info into variant SafeArray
      If IsEmpty(ViewGeom) Then
        ReadView = -3: Exit Function
      End If
    
      TotalVariantIndex = UBound(ViewGeom)    ' get total Number of Items in SafeArray
      CurrentVariantIndex = 0                 ' Seed Index into SafeArray
    
    Do
       GeometryType = ViewGeom(CurrentVariantIndex)   ' Get Type of geometry
       CurrentVariantIndex = CurrentVariantIndex + 1  ' Increment Index to Next item in SafeArray
       Select Case GeometryType
       
           Case 0 ' PolyLine/Line
             GeomCount = GeomCount + 1  ' Increment geometry Counter
             ReDim Preserve GeomData(0 To GeomCount) As GeomInfo
             CurrentVariantIndex = CurrentVariantIndex + 7  ' ignore Layer Info, linetype, etc
             
             NumPolyPoints& = ViewGeom(CurrentVariantIndex) ' Point data begins here
             CurrentVariantIndex = CurrentVariantIndex + 1
             If NumPolyPoints& > 0 Then                 ' 1-based Index, if more than 2 points, then a polyline
             
                MaxBound& = (NumPolyPoints& * 3) - 1   ' Number Loops of XYZ points, 0-based
                RedimBound& = (NumPolyPoints& * 2) - 1 ' Number of Points, excluding Z Axis
                ReDim PointStorage(RedimBound&)
                RedimBound& = 0 ' reset variable to now be our counter into geometry
                
                For PointEnt& = 1 To MaxBound& + 1 ' Grab one point at a time
                   If (PointEnt& Mod 3) > 0 Then
                      PointStorage(RedimBound&) = ViewGeom(CurrentVariantIndex) * ConversionFactor  ' translate to inch
                      RedimBound& = RedimBound& + 1
                   End If
                   CurrentVariantIndex = CurrentVariantIndex + 1
                Next PointEnt&
                
                GeomData(GeomCount).PointArray = PointStorage
                If NumPolyPoints& > 2 Then                  ' its a polyLine
                    GeomData(GeomCount).EntityType = 2
                Else                                        ' its a line
                    GeomData(GeomCount).EntityType = 1
                End If
             Else  ' we're hitting unknown data, better leave quietly
                ReadView = -4: Exit Function
             End If
             
           Case 1 ' Arc/Circle
             GeomCount = GeomCount + 1  ' Increment geometry Counter
             
             ' first, see if its an usupported  spline, etc.. arcs/circles will have 12 points
             NumPolyPoints& = ViewGeom(CurrentVariantIndex)  ' Number of Points (MOD 12)
             ReDim Preserve GeomData(0 To GeomCount) As GeomInfo
             CurrentVariantIndex = CurrentVariantIndex + 1        ' increment counter into THIS entity
             
              If NumPolyPoints& = 12 Then  ' 1-based counter
                 MaxBound& = (NumPolyPoints& - 1)
                 RedimBound& = 5 ' xy center, xy start, xy end
                 ReDim PointStorage(RedimBound&)
                 RedimBound& = 0 ' reset variable to now be our counter into geometry
                  
                 For PointEnt& = 1 To MaxBound& + 1
                     If PointEnt& = 12 Then ' check for "backwards" arcs
                        If ViewGeom(CurrentVariantIndex) <> 1 Then ReverseArc% = True Else ReverseArc% = False
                     End If
                 
                    ArrayIndex& = (PointEnt& Mod 3)
                    If (ArrayIndex& > 0) And (PointEnt& < 9) Then ' ignore every 3rd (Z axis) Point
                         PointStorage(RedimBound&) = ViewGeom(CurrentVariantIndex) * ConversionFactor   ' translate to inch
                         RedimBound& = RedimBound& + 1
                    End If
                    CurrentVariantIndex = CurrentVariantIndex + 1  ' increment counter
                 Next PointEnt&
                 
                 ' reverse start and endpoints of arc if Flagged above with "ReverseArc" varaible
                 If ReverseArc% = True Then GeomData(GeomCount).Normal = -1
                 GeomData(GeomCount).PointArray = PointStorage
                 
                 CurrentVariantIndex = CurrentVariantIndex + 4  ' skip over fonts, etc
                 GeomData(GeomCount).EntityType = 3
                 CurrentVariantIndex = CurrentVariantIndex + 2
                 NumPolyPoints& = ViewGeom(CurrentVariantIndex) '
                 CurrentVariantIndex = CurrentVariantIndex + 1
                 
                 If NumPolyPoints& > 0 Then     ' shouldnt need these - possibly for SPLINE layout
                    For I% = 1 To (NumPolyPoints& * 3)
                      CurrentVariantIndex = CurrentVariantIndex + 1
                    Next I%
                 Else  ' we're hitting unknown data, better leave quietly
                    ReadView = -5: Exit Function
                 End If
             Else   '  Spline - you're bummin
                ReadView = -1: Exit Function ' return empty
             End If
             
           Case Else    ' who knows what the next service pack will bring?
                ReadView = -2: Exit Function ' return empty
       End Select
       
       If CurrentVariantIndex >= TotalVariantIndex Then AllGeometryIsExtracted = True
    Loop Until AllGeometryIsExtracted

    

End Function


Public Function Atan2(ByVal X As Double, ByVal Y As Double) As Double
 ' returns a 4-quadrant arc tangent,in radians,
 ' given an incremental x/y distance from zero.
 
  Dim theta As Double
  
  If (Abs(X) < 0.0000001) Then
    If (Abs(Y) < 0.0000001) Then
      theta = 0#
    ElseIf (Y > 0#) Then
      theta = (Pi / 2#)
    Else
      theta = (Pi / -2#)
    End If
  Else
    theta = Atn(Y / X)
  
    If (X < 0) Then
      If (Y >= 0#) Then
        theta = Pi + theta
      Else
        theta = theta - Pi
      End If
    End If
  End If
  
  If theta < 0 Then theta = ((Pi + theta) + Pi)
    
  Atan2 = theta
  
End Function



Function DxfExport(Comment As String) As String
    ' Returns a string containing an entire DXF output file of the Entities section.
    ' Forces DXF output to "DecimalPlaces" to the right of the decimal point.
    ' If the "Comment" field is passed, it embeds the Comment into the DXF.
    ' Note that while the comment field is supported in DXFs, it will not be imported
    ' into Dwgs, or any other application


    Dim TempPointInfo() As Variant ' Store Point clouds
    Dim TempVal As Double, TempVal2 As Double
    Dim EntityCount As Long
    Dim PartTolerance As Double, ArcRadius As Double
    Dim NumFmt As String, CR As String
    Dim LineHeader As String, PolyLineHeader As String, VertexHeader As String, ArcNormal As String
    Dim CircleHeader As String, ArcHeader As String
    Dim firstBnd As Variant
    Dim ResizeFactor As Double
    

    If GeomCount = -1 Then Exit Function ' return an empty string if no geometry
    LayerName = DXFLayerName
    If LayerName = "" Then LayerName = "0"  ' force a layer name


    ' Describe the output format for the DXF
    NumFmt = "###0." & String$(DecimalPlaces, "0")
    CR = Chr(13) & Chr(10)  ' define LineFeed character
    
    LineHeader = "  0" & CR & "LINE" & CR & "  8" & CR & LayerName & CR  ' Embed Export Layer Name
    PolyLineHeader = "  0" & CR & "POLYLINE" & CR & "  8" & CR & LayerName & CR  ' Embed Export Layer Name
    VertexHeader = "  0" & CR & "VERTEX" & CR & "  8" & CR & LayerName & CR  ' Embed Export Layer Name
    CircleHeader = "  0" & CR & "CIRCLE" & CR & "  8" & CR & LayerName & CR  ' Embed Export Layer Name
    ArcHeader = "  0" & CR & "ARC" & CR & "  8" & CR & LayerName & CR  ' Embed Export Layer Name
    ArcNormal = "210" & CR & "0.0" & CR & "220" & CR & "0.0" & CR & "230" & CR & "-1.0" & CR  ' reverse arc normal for CW arcs

    ' format Min and max decimal places
    If DecimalPlaces < 1 Then
        PartTolerance = 1#
    ElseIf DecimalPlaces > 32 Then
        PartTolerance = 32#
    Else
        PartTolerance = CDbl(DecimalPlaces)
    End If
    ' reformat Tolerance to actual Number
    PartTolerance = CDbl("." & String(PartTolerance - 1, "0") & "1") ' ".01" for 2 places, ".00001" for 5 places, etc

    ' Create Entities section  Header
      DxfExport = "  0" & CR & "SECTION" & CR & "  2" & CR & "ENTITIES" & CR

    ' Loop thru Geometry and Export entities as they are found
    For EntityCount = 0 To GeomCount
        TempPointInfo = GeomData(EntityCount).PointArray   ' get Point cloud info for entity
        Select Case GeomData(EntityCount).EntityType
            Case 1      ' Line, we have 4 points to output, force Z axis
            Debug.Print "line"
                DxfExport = DxfExport & LineHeader  ' add start of Line Header
                DxfExport = DxfExport & " 62" & CR & Space$(4) & AcadLineColor & CR ' Entity Color
                DxfExport = DxfExport & " 10" & CR & Format(TempPointInfo(0) / ResizeFactor, NumFmt) & CR ' X1
                DxfExport = DxfExport & " 20" & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR  ' Y1
                DxfExport = DxfExport & " 30" & CR & Format(0#, NumFmt) & CR                ' Z1
                DxfExport = DxfExport & " 11" & CR & Format(TempPointInfo(2) / ResizeFactor, NumFmt) & CR  ' X2
                DxfExport = DxfExport & " 21" & CR & Format(TempPointInfo(3) / ResizeFactor, NumFmt) & CR  ' Y2
                DxfExport = DxfExport & " 31" & CR & Format(0#, NumFmt) & CR                ' Z2
            Case 2      ' PolyLine
                DxfExport = DxfExport & PolyLineHeader  ' add start of PolyLine Header
                DxfExport = DxfExport & " 62" & CR & Space$(4) & AcadPolyColor & CR ' Entity Color
                DxfExport = DxfExport & " 66" & CR & "     1" & CR   ' another header
                DxfExport = DxfExport & " 10" & CR & Format(TempPointInfo(0) / ResizeFactor, NumFmt) & CR   ' X1
                DxfExport = DxfExport & " 20" & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR   ' Y1
                DxfExport = DxfExport & " 30" & CR & Format(0#, NumFmt) & CR                 ' Z1
                
                ' see if the polyline is closed, at elast within our tolerance
                TempVal = LineLength(EntityCount, 0#, EntityCount, UBound(TempPointInfo)) - 1
                If TempVal <= GapTolerance Then PClosed$ = "     1" Else PClosed$ = "     0"
                DxfExport = DxfExport & " 70" & CR & PClosed$ & CR  ' Describe open or Closed polyLine
                
                ' Loop thru the rest of the pairs of coords
                For VertexCounter& = 2 To UBound(TempPointInfo) - 1 Step 2
                    DxfExport = DxfExport & VertexHeader  ' add start of Vertex Header
                    DxfExport = DxfExport & " 10" & CR & Format(TempPointInfo(VertexCounter&) / ResizeFactor, NumFmt) & CR     ' Vertex X
                    DxfExport = DxfExport & " 20" & CR & Format(TempPointInfo(VertexCounter& + 1) / ResizeFactor, NumFmt) & CR ' Vertex Y
                    DxfExport = DxfExport & " 30" & CR & Format(0#, NumFmt) & CR                                ' Vertex Z
                Next VertexCounter&
                DxfExport = DxfExport & "  0" & CR & "SEQEND" & CR & "  8" & CR & LayerName & CR  ' add final layer reference
    
            Case 3      ' Arc/Circle
                ' compute the radius of the Arc/Circle
                ArcRadius = (LineLength(EntityCount, 0#, EntityCount, 2#)) / ResizeFactor
                ' Now see if It is an arc or a circle; acad makes the distinction
                TempVal = (LineLength(EntityCount, 2#, EntityCount, 4#) / ResizeFactor)

                If TempVal <= GapTolerance Then             ' autocad circle
                    DxfExport = DxfExport & CircleHeader  ' add start of Vertex Header
                    DxfExport = DxfExport & " 62" & CR & Space$(4) & AcadCircleColor & CR ' Entity Color
                    DxfExport = DxfExport & " 10" & CR & Format(TempPointInfo(0) / ResizeFactor, NumFmt) & CR  ' Center X
                    DxfExport = DxfExport & " 20" & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR  ' Center Y
                    DxfExport = DxfExport & " 30" & CR & Format(0#, NumFmt) & CR                ' Center Z
                    DxfExport = DxfExport & " 40" & CR & Format(ArcRadius, NumFmt) & CR         ' Radius
                Else                                        ' arc
                    ' first set up factor for reversing normal of arc
                    If GeomData(EntityCount).Normal = -1 Then NormalFactor# = -1 Else NormalFactor# = 1
                     
                    DxfExport = DxfExport & ArcHeader  ' add start of arc Header
                    DxfExport = DxfExport & " 62" & CR & Space$(4) & AcadArcColor & CR ' Entity Color"
                    DxfExport = DxfExport & " 10" & CR & Format(TempPointInfo(0) * NormalFactor# / ResizeFactor, NumFmt) & CR ' Center X
                    DxfExport = DxfExport & " 20" & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR  ' Center Y
                    DxfExport = DxfExport & " 30" & CR & Format(0#, NumFmt) & CR                ' Center Z
                    DxfExport = DxfExport & " 40" & CR & Format(ArcRadius / ResizeFactor, NumFmt) & CR         ' Radius
                    
                    ' Now get the Start Angle and the End angle, convert to degrees
                    ' Compute Signed XY Distance from center to Arc Start
                    TempVal = (TempPointInfo(2) - TempPointInfo(0)) * NormalFactor# / ResizeFactor ' signed X Distance from Start
                    TempVal2 = (TempPointInfo(3) - TempPointInfo(1)) / ResizeFactor ' signed Y Distance from Start
                    ' use the Arcradius variable for return storage
                    ArcRadius = Atan2(TempVal, TempVal2)
                    ArcRadius = ArcRadius / Radn   ' convert to degrees
                    DxfExport = DxfExport & " 50" & CR & Format(ArcRadius, NumFmt) & CR  ' Start Angle in degrees
                    
                    ' Compute Signed XY Distance from center to Arc End
                    TempVal = (TempPointInfo(4) - TempPointInfo(0)) * NormalFactor# / ResizeFactor ' signed X Distance from End
                    TempVal2 = TempPointInfo(5) - TempPointInfo(1) / ResizeFactor ' signed Y Distance from End
                    ' use the Arcradius variable for return storage
                    ArcRadius = Atan2(TempVal, TempVal2)
                    ArcRadius = ArcRadius / Radn   ' convert to degrees
                    DxfExport = DxfExport & " 51" & CR & Format(ArcRadius, NumFmt) & CR  ' Start Angle in degrees
                    
                    ' if the arc/circle is reversed, add an extra "Normal" vector
                    If GeomData(EntityCount).Normal = -1 Then ' reversed arc
                        DxfExport = DxfExport & ArcNormal
                    End If
    
                End If
            Case Else   ' Ignore for Now
        End Select
    Next EntityCount
    
    ' conditionally export comment into DXF
    If Comment > "" Then
        DxfExport = DxfExport & "    999" & CR & Comment & CR
    End If
    
    DxfExport = DxfExport & "  0" & CR & "ENDSEC" & CR & "  0" & CR & "EOF" & CR  ' add DXF Footer

End Function

Function LineLength(GIndex1 As Long, VIndex1 As Long, GIndex2 As Long, VIndex2 As Long) As Double
    ' returns the Length of the distance between the 2 points passed. Each Point is
    ' represented by its First Axis location (X) in the array, passed as the GeomIndex
    '  number, and secondly by the Index into the PointArray.
        
    Dim X1 As Double, X2 As Double, Y1 As Double, Y2 As Double
    Dim XDist As Double, YDist As Double
    Dim PointStorage As Variant
    
    If VIndex2 + 1 > UBound(GeomData(GIndex2).PointArray) Then
        LineLength = 0: Exit Function
    End If

    X1 = GeomData(GIndex1).PointArray(VIndex1): Y1 = GeomData(GIndex1).PointArray(VIndex1 + 1)
    X2 = GeomData(GIndex2).PointArray(VIndex2): Y2 = GeomData(GIndex2).PointArray(VIndex2 + 1)

    If X1 = X2 And Y1 = Y2 Then LineLength = 0: Exit Function
    If X1 = X2 Then LineLength = Abs(Y1 - Y2): Exit Function
    If Y1 = Y2 Then LineLength = Abs(X1 - X2): Exit Function
    
    XDist = Abs(X1 - X2): YDist = Abs(Y1 - Y2)
    LineLength = Sqr((XDist ^ 2) + (YDist ^ 2))

End Function

Function WriteDXF(DxfData As String, FileSpec As String) As Boolean
    ' writes dxf to file in one chunk.
    
    
    DXFFile% = FreeFile
    On Error GoTo handler ' set up handler
    
    Open FileSpec For Output As #DXFFile%
        Print #DXFFile%, DxfData
        Close #DXFFile%
    On Error GoTo 0

    WriteDXF = True: Exit Function
    
handler:    'generic error handler
    WriteDXF = Err.Number
    Err.Clear
    Close #DXFFile%
   

End Function

RE: API: View to DXF module

(OP)
grrrr,,, didnt save unlinked module, one
Public reference was missing.

in rhe 'dxfexport' function change the following line:

"Dim ResizeFactor as double"
         to
"Dim ResizeFactor as double : ResizeFactor =1#"

that will get rid of error. sorry

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