Macro liaison de point esquisse 2d

Out of category
1

Bonjour à tous,

je souhaite réaliser une macro me permettant de relier un certain nombre de point en eux d'une manière bien précise: je réalise des plans en 2d d'escaliers.

j'importe à ce jour tous les points (qui sont dans un fichier Excel* de coordonnée x y z)  à l'aide d'une macro dans une une esquisse 2d et je relie ensuite à la main les points de façon a redessiner l'escalier.

*fichier excel: 3 colonnes  X Y Z

 

point A avec point B

Point C avec point D

Point A avec Point C

Point B avec Point D

Etc de façon à dessiner chaque marche.

ne maîtrisant pas VBA ou très peu, est ce que quelques âmes charitables me viendraient en aide?

Comment je vois la chose: je pense qu'il faut partir dans un 1er temps pour relier tout les nez de marche soit une paire de point:

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

puis relier chaque coté de marche A-C; B-D etc

chaque escalier ayant un nombre de marche diffèrent il faut que je puisse entrer une valeur afin de stopper la macro au bout de X marches.

chaque marche est définie par 2 points

le reste des points du fichier excel servant à des repères extérieurs aux propres marches comme des angle ou des retour de mur ces points là seront reliés à la main...

l'idée et de mettre cette fonction  dans mon fichier excel  à la suite de la fonction qui m'exporte les points vers solidworks 

voila je pense que ce n'est pas très complexe mais ne maîtrisant pas la programmation.. vaut mieux un qui sait que 10 qui cherchent comme disait l'autre... 

voila! si vous avez des questions je suis à votre disposition!

 

voici le code actuel:

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

merci de votre collaboration

Val

2

Salut. Essaye ca:

Note: ca créera une esquisse 3D. Si tu veux créer une esquisse 2D, enlève les lignes insert3Dsketch, les guillemets des lignes InsertSketch et remplace termes Range("C") par 0. Par contre il me semble que dans ce cas, il faut sélectionné un plan avec la ligne SelectByID2.

J'ai assumé que tu n'a pas besoin des points. Sinon remet ta boucle While .

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 « J'aime »
3

Bonsoir  Jérome, 

je tiens à te remercier de ton implication a résoudre mon problème, et je tiens à te présenter mes excuses pour mon retour si tardif.

je n'ai reçu aucune notification ou mail, je suis revenue ici par curiosité et la surprise une ame charitable m'a répondu !

Je teste cela des que je peux et te fais un retour!

je te remercie