Proper use of SaveAsFlatDXF

 

I'm writing a program to take .psm files and output .dxf files for the turret punch. I started with some code I found here. It seems to be working fine except I'm having trouble understanding how to control the Edge. I want them oriented so that the long edge is horizontal and the short edge is verticle. Please help.

 

ForEachMe.objModel In objModels

        If objModel.Name = "Design Model"Then

          objBody = objModel.Body

          objShells = objBody.Shells

          objShell = objShells.Item(0)

          objFaces = objShell.Faces

 

          ForEachMe.objFace In objFaces

            If objFace.Area > ddMaxSurf Then

              ddMaxSurf = objFace.Area

              objBiggestFace = objFace

            EndIf

          Next

 

          objEdges = objBiggestFace.Edges

 

          ForEachMe.objEdge In objEdges

            objEdgeUsed = objEdge

            objVertex = objEdgeUsed.StartVertex

            If objVertex IsNothingThen

              'Keep going.

            Else

              Exit For

            EndIf

          Next

 

          'Dim ddVertex As Double = 0

          'For Each Me.objEdge In objEdges

          '  If (System.Math.Abs(objEdge.EndVertex.ToString - objEdge.StartVertex.ToString) > ddVertex) Then

          '    objLongestEdge = objEdge

          '  End If

          'Next

          'objEdge = objEdges.Item(1)  '0 for now, may change this later.

          'objVertex = objEdge.StartVertex

          'objEdge = objVertex.Edges

 

        EndIf

      Next

 

Posted by: Terry Tyson
Post date: 9/23/2010 3:10:29 AM

1 REPLY

RE: Proper use of SaveAsFlatDXF

I copy here a full code I wrote in Excel.

The code take a file path for a group of selected cells and create a dxf.

 

Any doub please ask me.

 

 

Sub dxf()

Dim objApp As Object

Dim Celda As Object

Dim i As Integer

Dim HayRepetidos As Boolean

Dim ChapaEspecial As Boolean

Dim SinVertice As Boolean

Dim ChapaMec As Boolean

Dim Verifica As Boolean

Dim HayExistentes As Boolean

'Dim ObjSEF As SolidEdgeFramework.Window

Dim ExisteDXF As Boolean

Dim ExisteArc As Boolean

Dim HayArcInexistentes As Boolean

Dim NombreDXF As String

ExisteArc = False

ExisteDXF = False

HayExistentes = False

HayArcInexistentes = False

SinVertice = False

ChapaMec = False

ChapaEspecial = False

HayRepetidos = False

    'Verifica que el solid edge este activo

    On Error Resume Next

    Set objApp = GetObject(, "SolidEdge.Application")

    If Err.Number = 429 Then

        'Set objApp = CreateObject("SolidEdge.Application")

        MsgBox Prompt:="Debe abrir el Solid Edge"

        GoTo fin

    End If

    On Error GoTo 0

Range(Selection.Address).Select

For Each Celda In Range(Selection.Address)

    Application.StatusBar = "Procesando   " & Trim$(Celda.Value)

    Celda.Interior.ColorIndex = 8

    Verifica = False

    ExisteDXF = False

    ExisteArc = False

    'Marca los archivo ya procesados que se intentan volver a procesar

    For i = 0 To Indice

        If Ultima(i) = Celda.Value Then

        Verifica = True

        Celda.Interior.ColorIndex = 45

        End If

    Next i

    NombreDXF = Mid$(Trim(Celda.Value), 1, Len(Trim$(Celda.Value)) - 4) + ".dxf"

    If frmMenu.CkBoxSobDXF.Value = False Then

        ExisteDXF = VerificaExistencia(NombreDXF)

    Else

        ExisteDXF = False

    End If

    ExisteArc = VerificaExistencia(Trim$(Celda.Value))

    If ExisteArc Then

        If Not ExisteDXF Then

            ChapaEspecial = TipoChapa(Celda.Value)

            If Not ChapaEspecial Then

                If Not Verifica Then

                    If InStr(1, LCase$(Celda.Value), ".psm") Then

                        SinVertice = GuardaComoDXF(CStr(Trim$(Celda.Value)), NombreDXF)

                        If SinVertice = True Then

                            Celda.Interior.ColorIndex = 3

                        End If

                    End If

                Else

                    HayRepetidos = True

                End If

            Else

                Celda.Interior.ColorIndex = 15

                ChapaMec = True

            End If

        Else

            HayExistentes = True

            Celda.Interior.ColorIndex = 7

        End If

    Else

        HayArcInexistentes = True

        Celda.Interior.ColorIndex = 36

    End If

    NombreDXF = ""

    'Minimiza la ventana de SolidEdge

    On Error Resume Next

        objApp.WindowState = 2

    On Error GoTo 0

Next Celda

Application.StatusBar = "Alertas"

If HayRepetidos Then

MsgBox ("Hay archivos resaltados en NARANJA repetidos que no se procesaron")

End If

If SinVertice Then

MsgBox ("Hay archivos resaltados en ROJO que no se pudieron procesar")

End If

If ChapaMec Then

MsgBox ("Hay archivos resaltados en GRIS que no se procesaron (son chapas mecanizadas)")

End If

If HayExistentes Then

MsgBox ("Hay archivos resaltados en VIOLETA que no se procesaron porque se encontro que ya existía un DXF")

End If

If HayArcInexistentes Then

MsgBox ("Hay archivos resaltados en AMARILLO que no se procesaron porque no se encontraron")

End If

fin:

Application.StatusBar = False

End Sub

Private Function GuardaComoDXF(ArchivoPSM As String, ArchivoDXF As String)

Dim objApp As Object

Dim objDoc As Object

Dim ObjCaras As Object

Dim ObjCara As Object

Dim Edge As Object

Dim Edge1 As Object

Dim Vertice As Object

Dim Vertice1 As Object

Dim ObjOp As Object

Dim Operacion As Object

Dim Faces As Variant

Dim Area As Double

Dim Area1 As Double

Dim NroCaras As Integer

Dim i As Integer

Dim Cara As Integer

Dim NroEdges As Integer

Dim StartPoint(3) As Double

Dim EndPoint(3) As Double

Dim Largo1 As Double

Dim Largo As Double

 

 

    Set objApp = GetObject(, "SolidEdge.Application")

    'On Error Resume Next

        Set objDoc = objApp.Documents.Open(ArchivoPSM)

    'If Error 0 Then

    '    GuardaComoDXF = True

    '    If Not objDoc Is Nothing Then

    '        objDoc.Close False

    '    End If

    '    Exit Function

    'End If

    'On Error GoTo 0

    'Suprimer las operaciones cuyo nombre segun el nombre

    Set ObjOp = objDoc.Models.Item(1).Features

    For Each Operacion In ObjOp

        If InStr(1, LCase$(Operacion.Name), OpNombre1) 0 _

        Or InStr(1, LCase$(Operacion.Name), OpNombre2) 0 Then

            Operacion.Suppress = True

        End If

    Next Operacion

    'Comienza la rutina de guardar como dxf

    Set ObjCaras = objDoc.Models(1).Body.Shells

    NroCaras = objDoc.Models(1).Body.Shells(1).Faces.Count

    Area = 0

    For i = 0 To NroCaras

        Area1 = objDoc.Models(1).Body.Shells(1).Faces(i).Area

        If Area1 >= Area Then

            Area = Area1

            Cara = i

        End If

    Next i

    'NombreDXF = Mid$(Trim(Celda.Value), 1, Len(Trim(Celda.Value)) - 4) + ".dxf"

    Set ObjCara = objDoc.Models(1).Body.Shells(1).Faces(Cara)

    NroEdges = objDoc.Models(1).Body.Shells(1).Faces(Cara).Edges.Count

    Largo = 0

    For i = 0 To NroEdges

        Set Edge1 = objDoc.Models(1).Body.Shells(1).Faces(Cara).Edges(i)

        Set Vertice1 = objDoc.Models(1).Body.Shells(1).Faces(Cara).Edges(i).StartVertex

        Call Edge1.GetEndPoints(StartPoint, EndPoint)

        Largo1 = EdgeLong(StartPoint, EndPoint)

        If Not Vertice1 Is Nothing And Largo1 > Largo Then

            Set Vertice = Vertice1

            Set Edge = Edge1

            Largo = Largo1

        End If

    Next i

    If Not Vertice Is Nothing Then

        Call objDoc.Models.SaveAsFlatDXF(ArchivoDXF, ObjCara, Edge, Vertice)

    Else

        GuardaComoDXF = True

        If Not objDoc Is Nothing Then

            objDoc.Close False

        End If

        Exit Function

    End If

    'Termina la rutina de guardar como dxf

    ' Close the document without saving.

    If Not objDoc Is Nothing Then

        objDoc.Close False

    End If

    Ultima(Indice) = ArchivoPSM

    Indice = Indice + 1

    frmMenu.LblContador.Caption = Indice

End Function

Private Function EdgeLong(StartPoint() As Double, EndPoint() As Double)

Dim X1, Y1, Z1 As Double

Dim X2, Y2, Z2 As Double

X1 = StartPoint(0)

Y1 = StartPoint(1)

Z1 = StartPoint(2)

X2 = EndPoint(0)

Y2 = EndPoint(1)

Z2 = EndPoint(2)

EdgeLong = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2 + (Z1 - Z2) ^ 2)

End Function

'Esta funcion determina si la chapa tiene alguna particularidad

'por la cual no se le pueda realizar un DXF

Private Function TipoChapa(Archivo As String)

'If InStr(1, LCase$(Archivo), "hm") Then

'    TipoChapa = True

'ElseIf InStr(1, LCase$(Archivo), "hp") Then

'    TipoChapa = True

'ElseIf InStr(1, LCase$(Archivo), "hr") Then

'    TipoChapa = True

'End If

    TipoChapa = False

End Function

'Verifica si el archivo DXF que se intenta crear Existe

Private Function VerificaExistencia(Archivo As String)

    Dim a As Variant

    a = Dir(Archivo)

    If a "" Then

        VerificaExistencia = True

    Else

        VerificaExistencia = False

    End If

End Function

 

Posted by: Mariano Spini
Post date: 10/12/2010 4:36:31 PM