Macro 2d Sketch Point Link

Out of category
1

Hi all

I want to make a macro that allows me to connect a certain number of points in them in a very specific way: I make 2D plans of stairs.

I currently import all the points (which are in an Excel* file with x y z coordinates)  using a macro in a 2D sketch and I then connect the points by hand in order to redraw the staircase.

*excel file: 3 columns  X Y Z

 

point A with point B

Point C with point D

Point A with Point C

Point B with Point D

Etc in order to draw each step.

not mastering VBA or very little, would some charitable souls come to my aid?

How I see it: I think you have to start in a 1st time to connect all the stair nosings, i.e. a pair of stitches:

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

then connect each side of the step A-C; B-D etc

each staircase having a different number of steps, I must be able to enter a value in order to stop the macro at the end of X steps.

Each step is defined by 2 points

The rest of the points in the Excel file are used for landmarks outside the steps themselves, such as corners or wall returns, these points will be connected by hand...

The idea is to put this function  in my excel  file after the function that exports the points to solidworks 

I think it's not very complex but I don't master programming. It's better to have one who knows than 10 who are looking as the other said...  

Here! If you have any questions, I am at your disposal!

 

Here is the current code:

Private Sub btnTest_Click()
 Dim swApp As SldWorks.SldWorks
    Dim Part As ModelDoc2
    Dim i as Integer

    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
    Part.InsertSketch
    Part.SetAddToDB True

    i = 1
    While Range("A" & i). Value <> ""
        Part.CreatePoint2 Range("A" & i). Value / 100, Range("B" & i). Value / 100, 0
        'Part.CreatePoint2 Range("A" & i). Value / 1000, Range("B" & i). Value / 1000, Range("C" & i). Value / 1000
        i = i + 1
    Wend

    Part.SetAddToDB False
    Part.ClearSelection
    Part.InsertSketch
    Part.ClearSelection2 True
End Sub

Thank you for your collaboration

Valley

2

Hello. Try this:

Note: this will create a 3D sketch. If you want to create a 2D sketch, remove the insert3Dsketch lines, the quotation marks from the InsertSketch lines, and replace the Range("C") terms with 0. On the other hand, it seems to me that in this case, you have to select a plan with the line SelectByID2.

I assumed that you don't need the points. Otherwise put your While loop back on.

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 Likes
3

Good evening  Jerome, 

I would like to thank you for your involvement in solving my problem, and I would like to apologize for my late return.

I didn't receive any notification or email, I came back here out of curiosity and the surprise a charitable soul answered me!

I'll test this as soon as I can and give you feedback!

Thank you