API: View to DXF module 1

[rocheey]

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

 

[rocheey]

' 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 = &quot;&quot; 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 &quot;backwards&quot; 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 &quot;ReverseArc&quot; 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 &quot;DecimalPlaces&quot; to the right of the decimal point.
' If the &quot;Comment&quot; 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 = &quot;&quot; Then LayerName = &quot;0&quot; ' force a layer name


' Describe the output format for the DXF
NumFmt = &quot;###0.&quot; & String$(DecimalPlaces, &quot;0&quot
CR = Chr(13) & Chr(10) ' define LineFeed character

LineHeader = &quot; 0&quot; & CR & &quot;LINE&quot; & CR & &quot; 8&quot; & CR & LayerName & CR ' Embed Export Layer Name
PolyLineHeader = &quot; 0&quot; & CR & &quot;POLYLINE&quot; & CR & &quot; 8&quot; & CR & LayerName & CR ' Embed Export Layer Name
VertexHeader = &quot; 0&quot; & CR & &quot;VERTEX&quot; & CR & &quot; 8&quot; & CR & LayerName & CR ' Embed Export Layer Name
CircleHeader = &quot; 0&quot; & CR & &quot;CIRCLE&quot; & CR & &quot; 8&quot; & CR & LayerName & CR ' Embed Export Layer Name
ArcHeader = &quot; 0&quot; & CR & &quot;ARC&quot; & CR & &quot; 8&quot; & CR & LayerName & CR ' Embed Export Layer Name
ArcNormal = &quot;210&quot; & CR & &quot;0.0&quot; & CR & &quot;220&quot; & CR & &quot;0.0&quot; & CR & &quot;230&quot; & CR & &quot;-1.0&quot; & 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(&quot;.&quot; & String(PartTolerance - 1, &quot;0&quot & &quot;1&quot ' &quot;.01&quot; for 2 places, &quot;.00001&quot; for 5 places, etc

' Create Entities section Header
DxfExport = &quot; 0&quot; & CR & &quot;SECTION&quot; & CR & &quot; 2&quot; & CR & &quot;ENTITIES&quot; & 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 &quot;line&quot;
DxfExport = DxfExport & LineHeader ' add start of Line Header
DxfExport = DxfExport & &quot; 62&quot; & CR & Space$(4) & AcadLineColor & CR ' Entity Color
DxfExport = DxfExport & &quot; 10&quot; & CR & Format(TempPointInfo(0) / ResizeFactor, NumFmt) & CR ' X1
DxfExport = DxfExport & &quot; 20&quot; & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR ' Y1
DxfExport = DxfExport & &quot; 30&quot; & CR & Format(0#, NumFmt) & CR ' Z1
DxfExport = DxfExport & &quot; 11&quot; & CR & Format(TempPointInfo(2) / ResizeFactor, NumFmt) & CR ' X2
DxfExport = DxfExport & &quot; 21&quot; & CR & Format(TempPointInfo(3) / ResizeFactor, NumFmt) & CR ' Y2
DxfExport = DxfExport & &quot; 31&quot; & CR & Format(0#, NumFmt) & CR ' Z2
Case 2 ' PolyLine
DxfExport = DxfExport & PolyLineHeader ' add start of PolyLine Header
DxfExport = DxfExport & &quot; 62&quot; & CR & Space$(4) & AcadPolyColor & CR ' Entity Color
DxfExport = DxfExport & &quot; 66&quot; & CR & &quot; 1&quot; & CR ' another header
DxfExport = DxfExport & &quot; 10&quot; & CR & Format(TempPointInfo(0) / ResizeFactor, NumFmt) & CR ' X1
DxfExport = DxfExport & &quot; 20&quot; & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR ' Y1
DxfExport = DxfExport & &quot; 30&quot; & 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$ = &quot; 1&quot; Else PClosed$ = &quot; 0&quot;
DxfExport = DxfExport & &quot; 70&quot; & 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 & &quot; 10&quot; & CR & Format(TempPointInfo(VertexCounter&) / ResizeFactor, NumFmt) & CR ' Vertex X
DxfExport = DxfExport & &quot; 20&quot; & CR & Format(TempPointInfo(VertexCounter& + 1) / ResizeFactor, NumFmt) & CR ' Vertex Y
DxfExport = DxfExport & &quot; 30&quot; & CR & Format(0#, NumFmt) & CR ' Vertex Z
Next VertexCounter&
DxfExport = DxfExport & &quot; 0&quot; & CR & &quot;SEQEND&quot; & CR & &quot; 8&quot; & 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 & &quot; 62&quot; & CR & Space$(4) & AcadCircleColor & CR ' Entity Color
DxfExport = DxfExport & &quot; 10&quot; & CR & Format(TempPointInfo(0) / ResizeFactor, NumFmt) & CR ' Center X
DxfExport = DxfExport & &quot; 20&quot; & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR ' Center Y
DxfExport = DxfExport & &quot; 30&quot; & CR & Format(0#, NumFmt) & CR ' Center Z
DxfExport = DxfExport & &quot; 40&quot; & 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 & &quot; 62&quot; & CR & Space$(4) & AcadArcColor & CR ' Entity Color&quot;
DxfExport = DxfExport & &quot; 10&quot; & CR & Format(TempPointInfo(0) * NormalFactor# / ResizeFactor, NumFmt) & CR ' Center X
DxfExport = DxfExport & &quot; 20&quot; & CR & Format(TempPointInfo(1) / ResizeFactor, NumFmt) & CR ' Center Y
DxfExport = DxfExport & &quot; 30&quot; & CR & Format(0#, NumFmt) & CR ' Center Z
DxfExport = DxfExport & &quot; 40&quot; & 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 & &quot; 50&quot; & 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 & &quot; 51&quot; & CR & Format(ArcRadius, NumFmt) & CR ' Start Angle in degrees

' if the arc/circle is reversed, add an extra &quot;Normal&quot; 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 > &quot;&quot; Then
DxfExport = DxfExport & &quot; 999&quot; & CR & Comment & CR
End If

DxfExport = DxfExport & &quot; 0&quot; & CR & &quot;ENDSEC&quot; & CR & &quot; 0&quot; & CR & &quot;EOF&quot; & 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

 

[rocheey]

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

in rhe 'dxfexport' function change the following line:

&quot;Dim ResizeFactor as double&quot;
to
&quot;Dim ResizeFactor as double : ResizeFactor =1#&quot;

that will get rid of error. sorry