Makro 2d Skizze Punkt Verknüpfung

Out of category
1

Hallo ihr alle

Ich möchte ein Makro erstellen, das es mir ermöglicht, eine bestimmte Anzahl von Punkten auf eine ganz bestimmte Weise zu verbinden: Ich mache 2D-Pläne von Treppen.

Ich importiere derzeit alle Punkte (die sich in einer Excel*-Datei mit x y z-Koordinaten befinden)  mit einem Makro in einer 2D-Skizze und verbinde die Punkte dann von Hand, um die Treppe neu zu zeichnen.

*Excel-Datei: 3 Spalten  X Y Z

 

Punkt A mit Punkt B

Punkt C mit Punkt D

Punkt A mit Punkt C

Punkt B mit Punkt D

usw., um jeden Schritt zu zeichnen.

Wenn ich VBA nicht oder nur sehr wenig beherrsche, würden mir dann einige wohltätige Seelen zu Hilfe kommen?

Wie ich das sehe: Ich glaube, man muss in einem 1. Mal anfangen, um alle Treppenkanten, also ein Paar Stiche, zu verbinden:

a-b; c-d; e-f; etc

Verbinden Sie dann jede Seite der Stufe A-C; B-D usw.

Da jede Treppe eine unterschiedliche Anzahl von Stufen hat, muss ich in der Lage sein, einen Wert einzugeben, um das Makro am Ende von X Schritten zu stoppen.

Jeder Schritt wird durch 2 Punkte definiert

Der Rest der Punkte in der Excel-Datei wird für Orientierungspunkte außerhalb der Stufen selbst verwendet, wie z. B. Ecken oder Wandrücksprünge, diese Punkte werden von Hand verbunden...

Die Idee ist, diese Funktion  in meiner Excel-Datei  nach der Funktion zu platzieren, die die Punkte nach SOLIDWORKS exportiert

Ich denke, es ist nicht sehr komplex, aber ich beherrsche das Programmieren nicht. Es ist besser, einen zu haben, der sich auskennt, als 10, die so aussehen, wie der andere gesagt hat...  

Hier! Bei Fragen stehe ich Ihnen gerne zur Verfügung!

 

Hier ist der aktuelle Code:

Privater Sub btnTest_Click()
 Dim swApp als SldWorks.SldWorks
    Dimmteil als ModelDoc2
    Dim i als Integer

    Set swApp = CreateObject("SldWorks.Application")
    Set Part = swApp.ActiveDoc
    Wenn Teil nichts ist, dann
        MsgBox "Bitte aktivieren Sie ein Teiledokument, bevor Sie dieses Makro verwenden."
        Sub beenden
    Ende, wenn
    Wenn Part.GetType <> 1 dann
        MsgBox "Bitte aktivieren Sie ein Teiledokument, bevor Sie dieses Makro verwenden."
        Sub beenden
    Ende, wenn
    Wenn nicht, ist Part.GetActiveSketch2 nichts, dann
        MsgBox "Bitte beenden Sie den Sketch, bevor Sie dieses Makro ausführen."
        Sub beenden
    Ende, wenn

    Part.ClearSelection2 Wahr
    Part.InsertSketch
    Part.SetAddToDB Wahr

    i = 1
    Während Bereich("A" & i). Wert <> ""
        Part.CreatePoint2 Range("A" & i). Wert / 100, Bereich("B" & i). Wert / 100, 0
        'Part.CreatePoint2 Bereich("A" & i). Wert / 1000, Bereich ("B" & i). Wert / 1000, Bereich ("C" & i). Wert / 1000
        i = i + 1
    Wend

    Part.SetAddToDB Falsch
    Part.ClearSelection
    Part.InsertSketch
    Part.ClearSelection2 Wahr
Ende Sub

Vielen Dank für Ihre Zusammenarbeit

Tal

2

Hallo. Versuchen Sie Folgendes:

Hinweis: Dadurch wird eine 3D-Skizze erstellt. Wenn Sie eine 2D-Skizze erstellen möchten, entfernen Sie die insert3Dsketch-Zeilen und die Anführungszeichen aus den InsertSketch-Zeilen , und ersetzen Sie die Range("C")-Terme durch 0. Auf der anderen Seite scheint es mir, dass Sie in diesem Fall einen Plan mit der Zeile SelectByID2 auswählen müssen.

Ich bin davon ausgegangen, dass man die Punkte nicht braucht. Andernfalls schalten Sie Ihre While-Schleife wieder ein.

Private Sub btnTest_Click()
    Dim swApp As SldWorks.SldWorks
    Dim Part As SldWorks.ModelDoc2
    Dim skSegment As SldWorks.SketchSegment
    Dim i As Integer
    Dim j As Integer
    Dim boolstatus As Boolean

    Set swApp = CreateObject("SldWorks.Application")
    Set Part = swApp.ActiveDoc
    If Part Is Nothing Then
        MsgBox "Please activate a part document before using this macro."
        Exit Sub
    End If
    If Part.GetType <> 1 Then
        MsgBox "Please activate a part document before using this macro."
        Exit Sub
    End If
    If Not Part.GetActiveSketch2 Is Nothing Then
        MsgBox "Please exit the sketch before running this macro."
        Exit Sub
    End If

    Part.ClearSelection2 True
    'boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
    'Part.InsertSketch
    Part.SketchManager.Insert3DSketch True
    Part.SetAddToDB True

    i = 1
    While Range("A" & i).Value <> ""
        j = i + 1
        If i Mod 4 = 0 Then j = i - 3
        Set skSegment = Part.SketchManager.CreateLine(Range("A" & i).Value / 1000, Range("B" & i).Value / 1000,  Range("C" & i).Value / 1000, Range("A" & j).Value / 1000, Range("B" & j).Value / 1000,  Range("C" & j).Value / 1000)
        i = i + 1
    Wend

    Part.SetAddToDB False
    'Part.InsertSketch
    Part.SketchManager.Insert3DSketch True
    Part.ClearSelection2 True
End Sub

 

2 „Gefällt mir“
3

Guten Abend  Jerome, 

Ich möchte Ihnen für Ihr Engagement bei der Lösung meines Problems danken und mich für meine späte Rückkehr entschuldigen.

Ich habe keine Benachrichtigung oder E-Mail erhalten, ich bin aus Neugier hierher zurückgekehrt und die Überraschung war, dass mir eine wohltätige Seele geantwortet hat!

Ich werde das so schnell wie möglich testen und Ihnen Feedback geben!

Vielen Dank