@m_griffin2WHPP
Here is another approach that might work for you.
We use this for unwrapped surfaces, a couple of advantages with this method.
- You can unwrap the same surface multiple times and name the unwrapped surface bodies differently. This gets around the limitation of only one named entity for a face.
- You can then orient the surface body with respect to the UCS (if this is a requirement for you), flip, mirror, rotate. The exported surface will take its orientation from the UCS.
Take a look at the below, you would need to add your logic for processing multiple surfaces and parts, but it should be pretty easy.
Sub Main()
Dim oDoc As Document = ThisDoc.Document
ThisApplication.StatusBarText = "Select a Unfolded Surface to Export as DXF"
Dim entity = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFaceFilter, "Select a Unfolded Surface to Export as DXF")
oDoc.SelectSet.Select(entity)
Dim oFace As Face
oFace = oDoc.SelectSet(1)
If Not oFace.SurfaceType = SurfaceTypeEnum.kPlaneSurface Then
MessageBox.Show("A planar face must be selected, the rule will exit", "Error Handling")
Return
End If
strDxfTextLine1 = "Text Line 1"
strDxfTextLine2 = "Text Line 2"
strDxfTextLine3 = "Text Line 3"
strDxfTextLine4 = "Text Line 4"
strDxfTextLine5 = "Text Line 5"
DXF_FileName = ThisDoc.PathAndFileName(False) & ".dxf"
Call Process_oSB_DXF(oFace, oDoc, DXF_FileName, strDxfTextLine1, strDxfTextLine2, strDxfTextLine3, strDxfTextLine4, strDxfTextLine5)
End Sub
Sub Process_oSB_DXF(oFace As Face, oDoc As PartDocument, DXF_FileName As String, strDxfTextLine1 As String, strDxfTextLine2 As String, strDxfTextLine3 As String, strDxfTextLine4 As String, strDxfTextLine5 As String)
Dim oSelectSet As SelectSet = oDoc.SelectSet
oSelectSet.Select(oFace)
Dim DXF_FullFileName As String = DXF_FileName
'MessageBox.Show(DXF_FullFileName)
Dim File As New System.IO.StreamWriter(DXF_FullFileName)
SharedVariable("DXF_Data_Exists") = False
SharedVariable("PosX") = 0
SharedVariable("PosY") = 0
DXFHeader(File)
ExportFace(oFace, File)
'MessageBox.Show("PosX = " & SharedVariable("PosX") & "PosY = " & SharedVariable("PosY"))
oSelectSet.Clear()
Call DXFAddText(File, strDxfTextLine1, SharedVariable("PosX"), SharedVariable("PosY"))
Call DXFAddText(File, strDxfTextLine2, SharedVariable("PosX"), SharedVariable("PosY") - 5)
Call DXFAddText(File, strDxfTextLine3, SharedVariable("PosX"), SharedVariable("PosY") -10)
Call DXFAddText(File, strDxfTextLine4, SharedVariable("PosX"), SharedVariable("PosY") -15)
Call DXFAddText(File, strDxfTextLine5, SharedVariable("PosX"), SharedVariable("PosY") -20)
DXFFooter(File,DXF_FullFileName)
End Sub
Sub CalculatePosX_PosY(oPointCol As List(Of Double()), oFace As Face)
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oPoint As Point
Dim Array_X As New ArrayList
Dim Array_Y As New ArrayList
For i = 0 To oPointCol.Count - 1
Array_X.Add(oPointCol(i)(0))
Array_Y.Add(oPointCol(i)(1))
Next
Array_X.Sort()
Array_Y.Sort()
minX = Array_X(0)
maxX = Array_X(Array_X.Count-1)
minY = Array_Y(0)
maxY = Array_Y(Array_X.Count - 1)
obx_x = (maxX - minX) 'oriented bounding box X dimension
obx_y = (maxY - minY) 'oriented bounding box Y dimension
obxc_x = ((maxX - minX) / 2) + minX 'oriented bounding box center X measurement
obxc_y = ((maxY - minY) / 2) + minY 'oriented bounding box center Y measurement
obx_counter_X = Round(obx_x / 5)
obx_counter_Y = Round(obx_y/5)
Intercept_X_Counter = 0
For i = 0 To Round(obx_counter_X / 2)
X_Val = obxc_x - (5 * i)
Y_Val = obxc_y
oPoint = oTG.CreatePoint(X_Val/10, Y_Val/10, 0)
Call InterceptFaceCheck(oPoint, oFace)
If SharedVariable("InterceptSuccessful") = True Then
'MessageBox.Show("Ray Intercepted Face: " & oFace.SurfaceBody.Name & vbNewLine & "X: " & Round(X_Val) & ", Y: " & Round(Y_Val))
Intercept_X_Counter += 1
If Intercept_X_Counter = 2 Then
GoTo Start_Y_Intercept
End If
End If
Next
Intercept_X_Counter = 0
For i = 0 To Round(obx_counter_X / 2)
X_Val = obxc_x + (5 * i)
Y_Val = obxc_y
oPoint = oTG.CreatePoint(X_Val/10, Y_Val/10, 0)
Call InterceptFaceCheck(oPoint, oFace)
If SharedVariable("InterceptSuccessful") = True Then
'MessageBox.Show("Ray Intercepted Face: " & oFace.SurfaceBody.Name & vbNewLine & "X: " & Round(X_Val) & ", Y: " & Round(Y_Val))
Intercept_X_Counter += 1
If Intercept_X_Counter = 2 Then
GoTo Start_Y_Intercept
End If
End If
Next
Start_Y_Intercept :
Intercept_Y_Counter = 0
For i = 0 To obx_counter_Y
Y_Val = Round(minY) + (5 * i)
oPoint = oTG.CreatePoint(X_Val/10, Y_Val/10, 0)
Call InterceptFaceCheck(oPoint, oFace)
If SharedVariable("InterceptSuccessful") = True Then
'MessageBox.Show("Ray Intercepted Face: " & oFace.SurfaceBody.Name & vbNewLine & "X: " & Round(X_Val) & ", Y: " & Round(Y_Val))
Intercept_Y_Counter += 1
If Intercept_Y_Counter = 5 Then
GoTo Declare_PosX_PosY
End If
End If
Next
Declare_PosX_PosY:
SharedVariable("PosX") = X_Val
SharedVariable("PosY") = Y_Val
'MessageBox.Show("PosX: " & SharedVariable("PosX") & vbNewLine & "PosY: " & SharedVariable("PosY"))
Array_X.Clear
Array_Y.Clear
End Sub
Sub InterceptFaceCheck(oPoint As Point, oFace As Face)
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oVector As UnitVector = oTG.CreateUnitVector(0,0,1) 'Vector direction is in the Z direction
Dim oFoundObjects As ObjectsEnumerator
Dim oFoundPoints As ObjectsEnumerator
Dim oSB As SurfaceBody = oFace.SurfaceBody
oSB.FindUsingRay(oPoint, oVector, 0, oFoundObjects, oFoundPoints)
SharedVariable("InterceptSuccessful") = False
Try
For Each oLocatedFace As Face In oFoundObjects
If oFace.SurfaceBody.Name = oLocatedFace.SurfaceBody.Name Then
SharedVariable("InterceptSuccessful") = True
End If
Next
Catch
'No Faces intercepted or unit vector is not normal to the face selected
End Try
End Sub
Sub DXFHeader(File As System.IO.StreamWriter)
' Write DXF header
File.WriteLine("0")
File.WriteLine("SECTION")
File.WriteLine("2")
File.WriteLine("ENTITIES")
End Sub
Sub DXFFooter(File As System.IO.StreamWriter,dxfFilename As String)
' Write DXF footer
File.WriteLine("0")
File.WriteLine("ENDSEC")
File.WriteLine("0")
File.WriteLine("EOF")
' Close the file
File.Close()
If SharedVariable("DXF_Data_Exists") = False Then
System.IO.File.Delete(dxfFilename)
End If
End Sub
Sub DXFAddText(file As System.IO.StreamWriter, TextToAdd As String, PosX As Double, PosY As Double)
file.WriteLine(" 0")
file.WriteLine("TEXT") 'ENTITY TYPE
file.WriteLine(" 8")
file.WriteLine("0") 'LAYERNAME
file.WriteLine("100")
file.WriteLine("AcDbText")
file.WriteLine("10")
file.WriteLine(PosX) 'X COORDINATE
file.WriteLine("20")
file.WriteLine(PosY) 'Y COORDINATE
file.WriteLine("30")
file.WriteLine("0.0") ' Z COORDINATE
file.WriteLine("40")
file.WriteLine("3.55") 'TEXT HEIGHT
file.WriteLine(" 1")
file.WriteLine(TextToAdd) 'TEXT STRING
file.WriteLine("100")
file.WriteLine("AcDbText") 'TEXT STRING
End Sub
Sub ExportFace(oFace As Face, File As System.IO.StreamWriter)
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oPointCol As New List(Of Double())
For Each oEL As EdgeLoop In oFace.EdgeLoops
For k = 1 To oEL.Edges.Count
oEdge = oEL.Edges(k)
oEdge_StopVertex = oEdge.StopVertex
oEdge_StartVertex = oEdge.StartVertex
oEdge_StopVertex_Coordinates = "X" & oEdge.StopVertex.Point.X & "Y" & oEdge.StopVertex.Point.Y & "Z" & oEdge.StopVertex.Point.Z
oEdge_StartVertex_Coordinates = "X" & oEdge.StartVertex.Point.X & "Y" & oEdge.StartVertex.Point.Y & "Z" & oEdge.StartVertex.Point.Z
' Dim oHSet As HighlightSet = oDoc.CreateHighlightSet()
' oHSet.Color = ThisApplication.TransientObjects.CreateColor(185, 0, 0) 'Red
' oHSet.AddItem(oEdge)
' MessageBox.Show("Edge type is " & oEdge.GeometryType & vbNewLine & "Start: " & oEdge_StartVertex_Coordinates & vbNewLine & "Stop: " & oEdge_StopVertex_Coordinates)
' oHSet.Clear()
If k = 1 Then 'first line in loop
Try
oNextEdge = oEL.Edges(k + 1)
oNextEdge_StopVertex_Coordinates = "X" & oNextEdge.StopVertex.Point.X & "Y" & oNextEdge.StopVertex.Point.Y & "Z" & oNextEdge.StopVertex.Point.Z
oNextEdge_StartVertex_Coordinates = "X" & oNextEdge.StartVertex.Point.X & "Y" & oNextEdge.StartVertex.Point.Y & "Z" & oNextEdge.StartVertex.Point.Z
Catch 'There is only 1 edge in the edge loop, does not need to be reversed
oNextEdge_StopVertex_Coordinates = oEdge_StopVertex_Coordinates
oNextEdge_StartVertex_Coordinates = oEdge_StartVertex_Coordinates
End Try
If oEdge_StopVertex_Coordinates <> oNextEdge_StartVertex_Coordinates And oEdge_StopVertex_Coordinates <> oNextEdge_StopVertex_Coordinates Then 'Current line needs to be reversed
If oEdge.GeometryType = CurveTypeEnum.kLineCurve Or oEdge.GeometryType = CurveTypeEnum.kLineSegmentCurve Then 'edge is straight
PointCollection(oPointCol, oEdge_StopVertex.Point.X, oEdge_StopVertex.Point.Y, oEdge_StopVertex.Point.Z, oTG, oSketch, oFace)
PointCollection(oPointCol, oEdge_StartVertex.Point.X, oEdge_StartVertex.Point.Y, oEdge_StartVertex.Point.Z, oTG, oSketch, oFace)
Else 'Edge is curved, or spline, polyline, eclipse, ect
CalculateEdgeStrokes(oEdge, oPointCol, oTG, oSketch, k, oFace, True)
End If
Else 'Line does not need to be reversed
If oEdge.GeometryType = CurveTypeEnum.kLineCurve Or oEdge.GeometryType = CurveTypeEnum.kLineSegmentCurve Then 'edge is straight
PointCollection(oPointCol, oEdge_StartVertex.Point.X, oEdge_StartVertex.Point.Y, oEdge_StartVertex.Point.Z, oTG,oSketch,oFace)
PointCollection(oPointCol, oEdge_StopVertex.Point.X, oEdge_StopVertex.Point.Y, oEdge_StopVertex.Point.Z, oTG, oSketch, oFace)
Else 'Edge is curved, or spline, polyline, eclipse, ect
CalculateEdgeStrokes(oEdge, oPointCol, oTG, oSketch, k, oFace, False)
End If
End If
Else 'Line is not first line in loop
If oEdge_StartVertex_Coordinates <> SharedVariable("LastPointCoordinates") Then 'line needs to be reversed
If oEdge.GeometryType = CurveTypeEnum.kLineCurve Or oEdge.GeometryType = CurveTypeEnum.kLineSegmentCurve Then 'edge is straight
PointCollection(oPointCol, oEdge_StopVertex.Point.X, oEdge_StopVertex.Point.Y, oEdge_StopVertex.Point.Z, oTG, oSketch, oFace)
PointCollection(oPointCol, oEdge_StartVertex.Point.X, oEdge_StartVertex.Point.Y, oEdge_StartVertex.Point.Z, oTG, oSketch, oFace)
Else 'Edge is curved, or spline, polyline, eclipse, ect
CalculateEdgeStrokes(oEdge, oPointCol, oTG, oSketch, k, oFace, True)
End If
Else 'Line does not need to be reversed
If oEdge.GeometryType = CurveTypeEnum.kLineCurve Or oEdge.GeometryType = CurveTypeEnum.kLineSegmentCurve Then 'edge is straight
PointCollection(oPointCol, oEdge_StartVertex.Point.X, oEdge_StartVertex.Point.Y, oEdge_StartVertex.Point.Z, oTG,oSketch,oFace)
PointCollection(oPointCol, oEdge_StopVertex.Point.X, oEdge_StopVertex.Point.Y, oEdge_StopVertex.Point.Z, oTG, oSketch, oFace)
Else 'Edge is curved, or spline, polyline, eclipse, ect
CalculateEdgeStrokes(oEdge, oPointCol, oTG, oSketch, k, oFace, False)
End If
End If
End If
Next
If oEL.IsOuterEdgeLoop = True Then
CalculatePosX_PosY(oPointCol, oFace)
End If
WritePointsToDXF(File, oPointCol)
oPointCol.Clear
Next
End Sub
Sub PointCollection(oPointCol As List(Of Double()), X As Double, Y As Double, Z As Double, oTG As TransientGeometry, oSketch As PlanarSketch,oFace As Face)
SharedVariable("LastPointCoordinates") = "X" & X & "Y" & Y & "Z" & Z
X_Value = X * 10
Y_Value = Y * 10
oPointCol.Add({X_Value, Y_Value})
'Logger.Debug("X: " & X_Value & ", Y: " & Y_Value)
End Sub
Sub CalculateEdgeStrokes(oEdge As Edge, oPointCol As List(Of Double()), oTG As TransientGeometry, oSketch As PlanarSketch, k As Integer, oFace As Face, ReverseLine As Boolean)
Dim oTempPointCol As New List(Of Double())
Dim lVertexCount As Long
Dim lSegmentCount As Long
Dim adVertexCoords() As Double = {}
Dim alVertexIndices() As Integer = {}
oEdge.CalculateStrokes(0.01, lVertexCount, lSegmentCount, adVertexCoords, alVertexIndices)
j = 1
For i = 0 To adVertexCoords.Length -1
If j = 1 Then
strCoord_X = adVertexCoords(i)
Else If j = 2 Then
strCoord_Y = adVertexCoords(i)
Else If j = 3 Then
strCoord_Z = adVertexCoords(i)
oTempPointCol.Add({strCoord_X, strCoord_Y, strCoord_Z})
j = 0 'reset the counter
End If
j = j + 1
Next
If ReverseLine = False Then
oEdge_StartVertex_Coordinates = "X" & oEdge.StartVertex.Point.X & "Y" & oEdge.StartVertex.Point.Y & "Z" & oEdge.StartVertex.Point.Z
Else 'Reverse line
oEdge_StartVertex_Coordinates = "X" & oEdge.StopVertex.Point.X & "Y" & oEdge.StopVertex.Point.Y & "Z" & oEdge.StopVertex.Point.Z
End If
strCurrentEdgeStartVertex = "X" & oTempPointCol(0)(0) & "Y" & oTempPointCol(0)(1) & "Z" & oTempPointCol(0)(2)
If strCurrentEdgeStartVertex = oEdge_StartVertex_Coordinates Then
For i = 0 To oTempPointCol.Count - 1
'MessageBox.Show("k = 1, point added to collecton. X:" & oTempPointCol(i)(0) & " Y:" & oTempPointCol(i)(1))
PointCollection(oPointCol, oTempPointCol(i)(0), oTempPointCol(i)(1), oTempPointCol(i)(2), oTG, oSketch,oFace)
Next
Else 'Points need to be reversed
For i = oTempPointCol.Count - 1 To 0 Step -1
'MessageBox.Show("k = 1, point added to collecton. X:" & oTempPointCol(i)(0) & " Y:" & oTempPointCol(i)(1))
PointCollection(oPointCol, oTempPointCol(i)(0), oTempPointCol(i)(1), oTempPointCol(i)(2), oTG, oSketch,oFace)
Next
End If
oTempPointCol.Clear
End Sub
Sub WritePointsToDXF(file As System.IO.StreamWriter, oPointCol As List(Of Double()))
SharedVariable("DXF_Data_Exists") = True
' Write lines to file
For i = 0 To oPointCol.Count - 2
file.WriteLine("0")
file.WriteLine("LINE")
file.WriteLine("8")
file.WriteLine("0")
file.WriteLine("10")
file.WriteLine(oPointCol(i)(0))
file.WriteLine("20")
file.WriteLine(oPointCol(i)(1))
file.WriteLine("11")
file.WriteLine(oPointCol(i+1)(0))
file.WriteLine("21")
file.WriteLine(oPointCol(i+1)(1))
Next
' Add the last line to close the shape
file.WriteLine("0")
file.WriteLine("LINE")
file.WriteLine("8")
file.WriteLine("0")
file.WriteLine("10")
file.WriteLine(oPointCol((oPointCol.Count - 1))(0))
file.WriteLine("20")
file.WriteLine(oPointCol((oPointCol.Count - 1))(1))
file.WriteLine("11")
file.WriteLine(oPointCol(0)(0))
file.WriteLine("21")
file.WriteLine(oPointCol(0)(1))
End Sub