DXF in Excel importieren

• Autor
  Beiträge
• 5. Dezember 2018 um 18:31 Uhr #28035
  JosefAdam

  Standard User

  • Beiträge 8

  Anzeige

  Hallo,

  bin neu im Forum. Ich würde gerne die Koordinaten (Linienstart und Ende) aus einer DXF Datei in Excel direkt importieren.

  Evtl. hat jemand schon Erfahrungen in dieser Richtung gemacht?

  Grüße

  27. Januar 2019 um 0:53 Uhr #28146
  Budaabu

  Standard User

  • Beiträge 2

  Was möchtest du damit erreichen? Generiere einen ISO Cod der gewüsten DXF Datei. Kopiere den Text und füge ihn in EXCEL ein.

  27. Januar 2019 um 21:17 Uhr #28149
  JosefAdam

  Standard User

  • Beiträge 8

  Hallo,

  danke für die Antwort. Hab es mittlerweile mit einem Macro ausprogrammiert…

  Somit habe ich die Koordinaten des Modells in Excel und kann diese in Graphen anzeigen und weiter verarbeiten.

  Grüße,

  Josef

  Anzeige
  11. Januar 2022 um 12:45 Uhr #34786
  manuel_b

  Standard User

  • Beiträge 2

  @josefadam

  wie hast du das genau gemacht?

  Danke

  Gruß

  12. Januar 2022 um 10:26 Uhr #34791
  JosefAdam

  Standard User

  • Beiträge 8

  Anzeige

  Hallo, is jetzt schon ne Zeit her…
  Mit einem Excel VBA Makro das DXF file geöffnet und zeilenweise eingelesen.
  Dann nach POINTS, LINE, LWPOLYLINE und ARC durchsucht und diese in Einzelkoordinaten umgewandelt…
  Weiß jetzt nicht wie gut du dich mit Excel Makros auskennst…

  Hier ein Beispielcode ( du brauchst eine Exceltabelle mit Namen „Main“, auf der kannst du dann über Button oder so  das Makro „ReadFileDXF“ aufrufen… ):

   

   

  Sub ReadFileDXF()

  Application.ScreenUpdating = False ‚ for performance reasons

  Worksheets(„Main“).Cells.ClearContents ‚ Clear all cells

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  ‚actual row number in excel sheed
  Dim RowIdx As Integer
  Dim FileInput As Integer

  RowIdx = 1

  ChDrive Left(ActiveWorkbook.Path, 1) ‚in drive des Worksheets wechseln
  ChDir ActiveWorkbook.Path ‚in pfad des Worksheets wechseln
  myFile = Application.GetOpenFilename(„CAD Files (*.dxf), *.dxf“)

  If myFile <> False Then

  Open myFile For Input As #1

  Do While Not EOF(1)

  ‚always read 2 lines
  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  ‚////////////////////////////////////////////////////////////////////
  ‚//This part interpretes the drawing objects found in the DXF file…
  ‚////////////////////////////////////////////////////////////////////

  If line1 = „0“ And line2 = „POINT“ Then
  Call PointModule(RowIdx)
  ElseIf line1 = „0“ And line2 = „LINE“ Then
  Call LineModule(RowIdx)
  ElseIf line1 = „0“ And line2 = „LWPOLYLINE“ Then
  Call PolylineModule(RowIdx)
  ElseIf line1 = „0“ And line2 = „CIRCLE“ Then
  ‚ MsgBox „CIRCLE found“
  ElseIf line1 = „0“ And line2 = „ARC“ Then
  Call ArcModule(RowIdx)
  End If

  ‚////////////////////////////////////////////////////////////////////
  ‚////////////////////////////////////////////////////////////////////

  Loop

  ‚ MsgBox „Reading file done“

  Close #1 ‚Close File
  Else
  MsgBox „No File selected“
  End If

  Application.ScreenUpdating = True ‚ for performance reasons

  End Sub

  Sub PointModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1 As String
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“

  Do

  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „10“ Then ‚Point X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Point Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  Exit Do
  End If
  Loop

  If X1 <> „“ And Y1 <> „“ Then ‚All Values found
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X1)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y1)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Point“
  RowIdx = RowIdx + 1
  End If

  End Sub

  Sub LineModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1, X2, Y2 As String
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“
  X2 = „“
  Y2 = „“

  Do

  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „10“ Then ‚Line start X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Line start Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „11“ Then ‚Line end X
  X2 = Trim(line2)
  X2 = Replace(X2, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „21“ Then ‚Line end Y
  Y2 = Trim(line2)
  Y2 = Replace(Y2, „.“, Application.DecimalSeparator, , 1)
  Exit Do
  End If
  Loop

  If X1 <> „“ And Y1 <> „“ And X2 <> „“ And Y2 <> „“ Then ‚All Values found
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X1)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y1)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Line start“
  RowIdx = RowIdx + 1
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X2)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y2)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Line End“
  RowIdx = RowIdx + 1
  End If

  End Sub

  Sub PolylineModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1, X2, Y2 As String
  Dim counter, numberOfVertices, openOrClosed As Integer
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“

  counter = 0
  numberOfVertices = 1
  openOrClosed = 0

  Do
  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „90“ Then ‚Number of Vertices
  numberOfVertices = CInt(line2)
  ElseIf line1 = „70“ Then ‚Open or closed
  openOrClosed = CInt(line2)
  ElseIf line1 = „10“ Then ‚Coordinate X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Coordinate Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  If X1 <> „“ And Y1 <> „“ Then ‚All Values found
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X1)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y1)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Polyline Idx “ & counter
  RowIdx = RowIdx + 1
  X1 = „“
  Y1 = „“
  End If
  counter = counter + 1
  End If

  Loop While counter < numberOfVertices

  End Sub

  Sub ArcModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1 As String
  Dim radius, angle1, angle2 As String
  Dim R, AStart, AEnd As Double
  Dim NumberOfPoints As Integer

  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“

  radius = „“
  angle1 = „“
  angle2 = „“

  Do

  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „10“ Then ‚Point X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Point Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „40“ Then ‚Radius
  radius = Trim(line2)
  radius = Replace(radius, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „50“ Then ‚Angle 1
  angle1 = Trim(line2)
  angle1 = Replace(angle1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „51“ Then ‚Angle 2
  angle2 = Trim(line2)
  angle2 = Replace(angle2, „.“, Application.DecimalSeparator, , 1)
  Exit Do
  End If

  Loop

  If X1 <> „“ And Y1 <> „“ And radius <> „“ And angle1 <> „“ And angle2 <> „“ Then ‚All Values found

  ‚Get Radius of ARC
  R = CDbl(radius)

  ‚Transform angles to radiant
  AStart = (CDbl(angle1) * WorksheetFunction.Pi) / 180
  AEnd = (CDbl(angle2) * WorksheetFunction.Pi) / 180

  ‚Calculate start point of ARC
  Worksheets(„Main“).Cells(RowIdx, 1).Value = X1 + (Cos(AStart) * R)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = Y1 + (Sin(AStart) * R)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „ARC Start“
  ‚ Worksheets(„Main“).Cells(RowIdx, 4).Value = CDbl(X1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 5).Value = CDbl(Y1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 6).Value = CDbl(radius)
  ‚ Worksheets(„Main“).Cells(RowIdx, 7).Value = CDbl(angle1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 8).Value = CDbl(angle2)
  RowIdx = RowIdx + 1

  ‚Calculate Numbers of points (min 1 deg steps)
  NumberOfPoints = Abs(CDbl(angle1) – CDbl(angle2)) + 1

  If NumberOfPoints > 2 Then
  Dim StepAngle As Double
  StepAngle = (AEnd – AStart) / NumberOfPoints

  Dim i As Integer
  For i = 1 To (NumberOfPoints – 1)
  Worksheets(„Main“).Cells(RowIdx, 1).Value = X1 + (Cos(AStart + (StepAngle * i)) * R)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = Y1 + (Sin(AStart + (StepAngle * i)) * R)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „ARC Part “ & i
  RowIdx = RowIdx + 1
  Next i
  End If

  ‚Calculate End point of ARC
  Worksheets(„Main“).Cells(RowIdx, 1).Value = X1 + (Cos(AEnd) * R)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = Y1 + (Sin(AEnd) * R)

  Worksheets(„Main“).Cells(RowIdx, 3).Value = „ARC End“
  ‚ Worksheets(„Main“).Cells(RowIdx, 4).Value = CDbl(X1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 5).Value = CDbl(Y1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 6).Value = CDbl(radius)
  ‚ Worksheets(„Main“).Cells(RowIdx, 7).Value = CDbl(angle1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 8).Value = CDbl(angle2)
  RowIdx = RowIdx + 1
  End If

  End Sub

  12. Januar 2022 um 13:47 Uhr #34794
  manuel_b

  Standard User

  • Beiträge 2

  Hallo Josef,

  leider kenne ich mich nicht so gut mit Macros aus. Muss ich den kompletten Code in das Macro kopieren? Bekomme bei ausführen einen Sytaxfehler.

  Danke

  12. Januar 2022 um 17:25 Uhr #34797
  JosefAdam

  Standard User

  • Beiträge 8

  Hallo,

  wie es aussieht hat leider dieser Chat alle VBA Kommentare (‚) zu (‚) geändert und ein paar andere Zeichen geändert.

  Was du versuchen könntest:

  1. neues Excel Sheet erstellen

  2. Benenne deine Tabelle zu „Main“ um

  3. Erstelle ein neues Makro „ReadFileDXF“ ( Entwicklertools->Makros->Erstellen )

  ( Falls Entwicklertools nicht angezeigt sind, dann google fragen, wie man die sichtbar macht.. )

  Es geht dann der VBA editor auf mit der Vorlage des Makros…

  4. Dann alles mit dem Text unten ersetzen ( Ich versuche es mal den hier als „Zitat“ einzufügen. Die Einrückungen sind zwar immer noch weg, aber das ist nur Kosmetik )
  5.  Anschließen das Makro ausführen, da musst du dann eine DXF auswählen…

  TEXT:

  Sub ReadFileDXF()

  Application.ScreenUpdating = False ‚ for performance reasons

  Worksheets(„Main“).Cells.ClearContents ‚ Clear all cells

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  ‚actual row number in excel sheed
  Dim RowIdx As Integer
  Dim FileInput As Integer

  RowIdx = 1

  ChDrive Left(ActiveWorkbook.Path, 1) ‚in drive des Worksheets wechseln
  myFile = Application.GetOpenFilename(„CAD Files (*.dxf), *.dxf“)

  If myFile <> False Then

  Open myFile For Input As #1

  Do While Not EOF(1)

  ‚always read 2 lines
  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  ‚////////////////////////////////////////////////////////////////////
  ‚//This part interpretes the drawing objects found in the DXF file…
  ‚////////////////////////////////////////////////////////////////////

  If line1 = „0“ And line2 = „POINT“ Then
  Call PointModule(RowIdx)
  ElseIf line1 = „0“ And line2 = „LINE“ Then
  Call LineModule(RowIdx)
  ElseIf line1 = „0“ And line2 = „LWPOLYLINE“ Then
  Call PolylineModule(RowIdx)
  ElseIf line1 = „0“ And line2 = „CIRCLE“ Then
  ‚ MsgBox „CIRCLE found“
  ElseIf line1 = „0“ And line2 = „ARC“ Then
  Call ArcModule(RowIdx)
  End If

  ‚////////////////////////////////////////////////////////////////////
  ‚////////////////////////////////////////////////////////////////////

  Loop

  ‚ MsgBox „Reading file done“

  Close #1 ‚Close File
  Else
  MsgBox „No File selected“
  End If

  Application.ScreenUpdating = True ‚ for performance reasons

  End Sub

  Sub PointModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1 As String
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“

  Do

  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „10“ Then ‚Point X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Point Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  Exit Do
  End If
  Loop

  If X1 <> „“ And Y1 <> „“ Then ‚All Values found
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X1)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y1)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Point“
  RowIdx = RowIdx + 1
  End If

  End Sub

  Sub LineModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1, X2, Y2 As String
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“
  X2 = „“
  Y2 = „“

  Do

  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „10“ Then ‚Line start X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Line start Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „11“ Then ‚Line end X
  X2 = Trim(line2)
  X2 = Replace(X2, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „21“ Then ‚Line end Y
  Y2 = Trim(line2)
  Y2 = Replace(Y2, „.“, Application.DecimalSeparator, , 1)
  Exit Do
  End If
  Loop

  If X1 <> „“ And Y1 <> „“ And X2 <> „“ And Y2 <> „“ Then ‚All Values found
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X1)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y1)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Line start“
  RowIdx = RowIdx + 1
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X2)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y2)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Line End“
  RowIdx = RowIdx + 1
  End If

  End Sub

  Sub PolylineModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1, X2, Y2 As String
  Dim counter, numberOfVertices, openOrClosed As Integer
  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“

  counter = 0
  numberOfVertices = 1
  openOrClosed = 0

  Do
  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „90“ Then ‚Number of Vertices
  numberOfVertices = CInt(line2)
  ElseIf line1 = „70“ Then ‚Open or closed
  openOrClosed = CInt(line2)
  ElseIf line1 = „10“ Then ‚Coordinate X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Coordinate Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  If X1 <> „“ And Y1 <> „“ Then ‚All Values found
  Worksheets(„Main“).Cells(RowIdx, 1).Value = CDbl(X1)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = CDbl(Y1)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „Polyline Idx “ & counter
  RowIdx = RowIdx + 1
  X1 = „“
  Y1 = „“
  End If
  counter = counter + 1
  End If

  Loop While counter < numberOfVertices

  End Sub

  Sub ArcModule(ByRef RowIdx As Integer)

  ‚these line1 and line2 is used for getting the a/m data groups…
  Dim line1, line2 As String
  Dim X1, Y1 As String
  Dim radius, angle1, angle2 As String
  Dim R, AStart, AEnd As Double
  Dim NumberOfPoints As Integer

  ‚line1 and line2 are are initialized here…
  line1 = „0“
  line2 = „0“

  X1 = „“
  Y1 = „“

  radius = „“
  angle1 = „“
  angle2 = „“

  Do

  Line Input #1, line1
  Line Input #1, line2

  line1 = Trim(line1)
  line2 = Trim(line2)

  If line1 = „10“ Then ‚Point X
  X1 = Trim(line2)
  X1 = Replace(X1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „20“ Then ‚Point Y
  Y1 = Trim(line2)
  Y1 = Replace(Y1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „40“ Then ‚Radius
  radius = Trim(line2)
  radius = Replace(radius, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „50“ Then ‚Angle 1
  angle1 = Trim(line2)
  angle1 = Replace(angle1, „.“, Application.DecimalSeparator, , 1)
  ElseIf line1 = „51“ Then ‚Angle 2
  angle2 = Trim(line2)
  angle2 = Replace(angle2, „.“, Application.DecimalSeparator, , 1)
  Exit Do
  End If

  Loop

  If X1 <> „“ And Y1 <> „“ And radius <> „“ And angle1 <> „“ And angle2 <> „“ Then ‚All Values found

  ‚Get Radius of ARC
  R = CDbl(radius)

  ‚Transform angles to radiant
  AStart = (CDbl(angle1) * WorksheetFunction.Pi) / 180
  AEnd = (CDbl(angle2) * WorksheetFunction.Pi) / 180

  ‚Calculate start point of ARC
  Worksheets(„Main“).Cells(RowIdx, 1).Value = X1 + (Cos(AStart) * R)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = Y1 + (Sin(AStart) * R)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „ARC Start“
  ‚ Worksheets(„Main“).Cells(RowIdx, 4).Value = CDbl(X1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 5).Value = CDbl(Y1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 6).Value = CDbl(radius)
  ‚ Worksheets(„Main“).Cells(RowIdx, 7).Value = CDbl(angle1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 8).Value = CDbl(angle2)
  RowIdx = RowIdx + 1

  ‚Calculate Numbers of points (min 1 deg steps)
  NumberOfPoints = Abs(CDbl(angle1) – CDbl(angle2)) + 1

  If NumberOfPoints > 2 Then
  Dim StepAngle As Double
  StepAngle = (AEnd – AStart) / NumberOfPoints

  Dim i As Integer
  For i = 1 To (NumberOfPoints – 1)
  Worksheets(„Main“).Cells(RowIdx, 1).Value = X1 + (Cos(AStart + (StepAngle * i)) * R)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = Y1 + (Sin(AStart + (StepAngle * i)) * R)
  Worksheets(„Main“).Cells(RowIdx, 3).Value = „ARC Part “ & i
  RowIdx = RowIdx + 1
  Next i
  End If

  ‚Calculate End point of ARC
  Worksheets(„Main“).Cells(RowIdx, 1).Value = X1 + (Cos(AEnd) * R)
  Worksheets(„Main“).Cells(RowIdx, 2).Value = Y1 + (Sin(AEnd) * R)

  Worksheets(„Main“).Cells(RowIdx, 3).Value = „ARC End“
  ‚ Worksheets(„Main“).Cells(RowIdx, 4).Value = CDbl(X1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 5).Value = CDbl(Y1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 6).Value = CDbl(radius)
  ‚ Worksheets(„Main“).Cells(RowIdx, 7).Value = CDbl(angle1)
  ‚ Worksheets(„Main“).Cells(RowIdx, 8).Value = CDbl(angle2)
  RowIdx = RowIdx + 1
  End If

  End Sub

  Anzeige
  12. Januar 2022 um 17:26 Uhr #34798
  JosefAdam

  Standard User

  • Beiträge 8

  ok, schade, der Chat hat wieder alle Kommentar Zeichen ersetzt 🙁

  12. Januar 2022 um 17:38 Uhr #34799
  JosefAdam

  Standard User

  • Beiträge 8

  Anzeige

  Kann hier leider nichts einfügen, dann musst du selber bei allen rot markierten Zeilen, die Kommas durch Hochkamma ersetzen.
  Dann alle Gänsefüßchen durch Gänsefüßchen ersetzen. (der Chat hat andere Zeichen draus gemacht)
  Und bei ein paar Zeilen ist es das „Minus“ und „Geteilt“ – einfach ersetzen durch „Minus“ und „Geteilt“

  12. Januar 2022 um 19:56 Uhr #34800
  admin

  Admin

  • Beiträge 199

  Hallo,

  ihr könnt ja mal versuchen den Code per Private Nachricht zu senden.

  Einfach unter dem Namen auf „Nachricht senden“

   

  13. Januar 2022 um 9:48 Uhr #34802
  JosefAdam

  Standard User

  • Beiträge 8

  Ok, vielen dank für den Hinweis 🙂 @manuel_b: ich hab dir ne Nachricht geschickt…

  3. Februar 2022 um 12:35 Uhr #43110
  Astrogator

  Standard User

  • Beiträge 1

  kann ich das macro auch haben heiko_hoffmannqlive.de ? Wäre sehr nett danke

  Anzeige
  3. Februar 2022 um 18:07 Uhr #43251
  JosefAdam

  Standard User

  • Beiträge 8

  Habs dir geschickt… Einfach mal ausprobieren… Grüße

• Autor
  Beiträge

Du bist noch nicht auf dxf-downloads.de angemeldet? Dann kannst du dich jetzt kostenlos anmelden.