Join 2 lines by points selection

[remyamaller]

Hello to all,

I come to you because I can't execute the _join command in VBA.

My macro allows to overlay a symbol that is implanted in a line, retrieve the coordinates of the lines that are around the symbol and join the lines. Here is my code:

Sub Supp_Sur_Ligne()

'------------------------------------------------------------------------------------------------------------------------
'Déclaration des variables locales---------------------------------------------------------------------------------------
'
Dim Entite As AcadEntity
Dim Selection_Symbole As AcadSelectionSet
Dim Block As AcadBlockReference
Dim L1 As AcadLine
Dim L2 As AcadLine
Dim Selection_Ligne1 As AcadSelectionSet
Dim Selection_Ligne2 As AcadSelectionSet
Dim Coordonnees_Ligne_1(0 To 2) As Double
Dim Coordonnees_Ligne_2(0 To 2) As Double
'
'Fin Déclaration des variables locales-----------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------------------------



'Sélection du symbole à supprimmer
ThisDrawing.SetVariable "SNAPMODE", 0
On Error Resume Next
If Not IsNull(ThisDrawing.SelectionSets.Item("ss1")) Then
    Set Selection_Symbole = ThisDrawing.SelectionSets.Item("ss1")
    Selection_Symbole.Delete
End If
Set Selection_Symbole = ThisDrawing.SelectionSets.Add("ss1")
Selection_Symbole.SelectOnScreen
ThisDrawing.SetVariable "SNAPMODE", 1

'For Each Entite In Selection_Symbole
''
'Next Entite

Set Block = Selection_Symbole(0)

    Select Case Block.Rotation
    'Virification de l'orientation de l'anglulaire de la ligne

        '¦---------------------------------------------------------¦
        '¦         Correspondance des angles dans AutoCad          ¦
        '¦---------------------------------------------------------¦
        '¦--Degrès--¦---GetAngle Returns-¦-GetOrientation returns--¦
        '¦     0    ¦          0.0       ¦    1.5707963267949      ¦
        '¦----------¦--------------------¦-------------------------¦
        '¦     90   ¦   1.5707963267949  ¦    3.14159265358979     ¦
        '¦----------¦--------------------¦-------------------------¦
        '¦    180   ¦   3.14159265358979 ¦    4.71238898038469     ¦
        '¦----------¦--------------------¦-------------------------¦
        '¦    270   ¦   4.71238898038469 ¦           0.0           ¦
        '¦----------¦--------------------¦-------------------------¦
        Case 0
        
        Coordonnees_Ligne_1(0) = Block.InsertionPoint(0) - 4
        Coordonnees_Ligne_1(1) = Block.InsertionPoint(1)
        Coordonnees_Ligne_1(2) = Block.InsertionPoint(2)
        
        Coordonnees_Ligne_2(0) = Block.InsertionPoint(0) + 4
        Coordonnees_Ligne_2(1) = Block.InsertionPoint(1)
        Coordonnees_Ligne_2(2) = Block.InsertionPoint(2)
        
        
        Case 1.5707963267949
        
        Coordonnees_Ligne_1(0) = Block.InsertionPoint(0)
        Coordonnees_Ligne_1(1) = Block.InsertionPoint(1) - 4
        Coordonnees_Ligne_1(2) = Block.InsertionPoint(2)
        
        Coordonnees_Ligne_2(0) = Block.InsertionPoint(0)
        Coordonnees_Ligne_2(1) = Block.InsertionPoint(1) + 4
        Coordonnees_Ligne_2(2) = Block.InsertionPoint(2)


End Select


Block.Delete

'Creation du jeu de selection

On Error Resume Next
  If Not IsNull(ThisDrawing.SelectionSets.Item("ss1")) Then
    Set Selection_Ligne1 = ThisDrawing.SelectionSets.Item("ss1")
    Selection_Ligne1.Delete
  End If
  
'Selection de la première ligne
Set Selection_Ligne1 = ThisDrawing.SelectionSets.Add("ss1")
Selection_Ligne1.SelectAtPoint Coordonnees_Ligne_1

'Selection de la deuxième ligne
Set Selection_Ligne2 = ThisDrawing.SelectionSets.Item("ss1")
Selection_Ligne1.SelectAtPoint Coordonnees_Ligne_2


Set L1 = Selection_Ligne1(0)
Set L2 = Selection_Ligne1(1)

'Test pour supprimmer les ligne = OK
'L1.Delete
'L2.Delete

'Joindre les deux ligne
ThisDrawing.SendCommand "_join" & vbCr & L1 & "," & L2


End Sub

Thanks in advance for your help! 😉

En vous remerciant par avance pour votre aide! 😉

[remyamaller]

Personne ne veut répondre....

Nobody wants to answer ....

[seabrahenrique]

Hey mate!

I guess is better to explain in english 😛

So, we can try to help!

[remyamaller]

Hello,

Thank you.

I have translate in english.

Sorry pour my english... 😞

[remyamaller]

Nobody wants to answer ....

[Ed__Jobe · Accepted solution]

You can't send VBA objects to the command line. However, the command line accepts lisp. Use my Ent2lspEnt function to return a lisp entity ID.

'Joindre les deux ligne
ThisDrawing.SendCommand "_join" & vbCr & Ent2lspEnt(L1) & "," & Ent2lspEnt(L2)

Public Function Ent2lspEnt(entObj As AcadEntity) As String
    'Designed to work with SendCommand, which can't pass objects.
    'This gets an objects handle and converts it to a string
    'of lisp commands that returns an entity name when run in SendCommand.
    Dim entHandle As String
    
    entHandle = entObj.Handle
    Ent2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

[Ed__Jobe]

---

@remyamaller wrote:

Nobody wants to answer ....

---

Nobody wants to say "thank you"?

[remyamaller · Accepted solution]

Hello Ed.Jobe,

I said thank you to HENRIQUESEABRA because he asked me to write in English.

Thanks for your answer.

J’ai testé la fonction et ça n’a pas fonctionné.

I tried your function but it doesn’t work because of “error syntax”. I found out the following code :

J’ai donc fait des recherches sur la fonction « handent » appuyant sur votre réponse et j’ai trouvé le code suivant qui fonctionne :

'Joindre les deux lignes
ThisDrawing.SendCommand "_join" & vbCr & Ent2lspEnt(L1) & vbCr & Ent2lspEnt(L2) & vbCr & vbCr


Public Function Ent2lspEnt(entObj As AcadLine) As String
    'Designed to work with SendCommand, which can't pass objects.
    'This gets an objects handle and converts it to a string
    'of lisp commands that returns an entity name when run in SendCommand.
    Dim entHandle As String

    entHandle = entObj.Handle
    Ent2lspEnt = "(handent """ & entHandle & """)"

End Function

Thanks again!!😃👍