join all lines

[rwbaker54]

Is there a way once i have all my lines drawn that I can join them together?

is there a mass join command?

the drawing of the lines is done thru vba.

i know you can use pedit while in autocad and can join lines
but i need to do this thru vba.

thanks in advance

[fixo]

Try this one

Function Is2DPointsEqual(p1 As Variant, p2 As Variant, gap As Double) As Boolean
     Is2DPointsEqual = False
     Dim a, b
     a = Abs(CDbl(p1(0)) - CDbl(p2(0)))
     b = Abs(CDbl(p1(1)) - CDbl(p2(1)))
     If a <= gap And b <= gap Then Is2DPointsEqual = True
     End Function
     
Sub JoinLines()
' based on idea by Norman Yuan
' Fatty T.O.H. () 2007 * all rights removed
' edited 02.04.2008
Dim oSsets As AcadSelectionSets
Dim pSset As AcadSelectionSet
Dim oSset As AcadSelectionSet
Dim setName As String
Dim fType(0) As Integer
Dim fData(0) As Variant
Dim varPt As Variant
Dim pickPt As Variant
Dim fLine As AcadLine
Dim oLine As AcadEntity
Dim oEnt As AcadEntity
Dim commStr As String
Dim stPt(1) As Double
Dim endPt(1) As Double
Dim dxftype, dxfcode
Dim n As Integer
Dim sp As Variant
Dim ep As Variant
Dim ps(1) As Double
Dim pe(1) As Double
Dim vexs As Variant
Dim oSpace As AcadBlock

With ThisDrawing
   If .ActiveSpace = acModelSpace Then
      Set oSpace = .ModelSpace
   Else
      Set oSpace = .PaperSpace
   End If
End With

On Error GoTo Error_Trapp

Dim osm
osm = ThisDrawing.GetVariable("OSMODE")
ThisDrawing.SetVariable "OSMODE", 1
ThisDrawing.SetVariable "PICKBOX", 1

pickPt = ThisDrawing.Utility.GetPoint(, vbCr & "Select the starting point of the chain of lines :")

ZoomExtents

Set oSsets = ThisDrawing.SelectionSets

fType(0) = 0: fData(0) = "LINE"
dxftype = fType: dxfcode = fData

     setName = "FirstLine"

          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          End With
          
     setName = "LineSset"

Set pSset = oSsets.Add("FirstLine")

pSset.SelectAtPoint pickPt, dxftype, dxfcode

If pSset.Count > 1 Then
MsgBox "More than one line selected" & vbCr & _
"Error"
Exit Sub
ElseIf pSset.Count = 1 Then
Set fLine = pSset.Item(0)
ElseIf pSset.Count = 0 Then
MsgBox "Nothing selected" & vbCr & _
"Error"
Exit Sub
End If

sp = fLine.StartPoint
ep = fLine.EndPoint
ps(0) = sp(0): ps(1) = sp(1)
pe(0) = ep(0): pe(1) = ep(1)
If Is2DPointsEqual(pickPt, ps, 0.01) Then
stPt(0) = ps(0): stPt(1) = ps(1)
endPt(0) = pe(0): endPt(1) = pe(1)
ElseIf Is2DPointsEqual(pickPt, pe, 0.01) Then
stPt(0) = pe(0): stPt(1) = pe(1)
endPt(0) = ps(0): endPt(1) = ps(1)
End If
Dim oPline As AcadLWPolyline
Dim coors(3) As Double
coors(0) = stPt(0): coors(1) = stPt(1)
coors(2) = endPt(0): coors(3) = endPt(1)
Set oPline = oSpace.AddLightWeightPolyline(coors)
pSset.Delete
Set pSset = Nothing

Set oSset = oSsets.Add("LineSset")
Dim remLine(0) As AcadEntity
Set remLine(0) = fLine
oSset.Select acSelectionSetAll, , , dxftype, dxfcode
oSset.RemoveItems remLine
fLine.Delete
Dim i As Long
i = 1
Dim Pokey As Boolean
Pokey = True
Do Until Not Pokey
    Pokey = False
    
Gumby:
For n = oSset.Count - 1 To 0 Step -1
Set oLine = oSset.Item(n)

sp = oLine.StartPoint
ep = oLine.EndPoint
ps(0) = sp(0): ps(1) = sp(1)
pe(0) = ep(0): pe(1) = ep(1)

If Is2DPointsEqual(ps, endPt, 0.01) Then
i = i + 1
oPline.AddVertex i, pe
Set remLine(0) = oLine
oSset.RemoveItems remLine
oLine.Delete
vexs = oPline.Coordinate(i)
endPt(0) = vexs(0): endPt(1) = vexs(1)
Pokey = True
Exit For
ElseIf Is2DPointsEqual(pe, endPt, 0.01) Then
i = i + 1
oPline.AddVertex i, ps
Set remLine(0) = oLine
oSset.RemoveItems remLine
oLine.Delete
vexs = oPline.Coordinate(i)
endPt(0) = vexs(0): endPt(1) = vexs(1)
Pokey = True
Exit For
End If

Next n
If oSset.Count > 0 Then
GoTo Gumby
Else
Exit Do
End If

Loop
oSset.Delete
Set oSset = Nothing

Error_Trapp:
ZoomPrevious
If Err.Number <> 0 Then
MsgBox "Error number: " & Err.Number & vbCr & Err.Description
End If
On Error Resume Next
ThisDrawing.SetVariable "OSMODE", osm
ThisDrawing.SetVariable "PICKBOX", 4 '<--change size to your suit

End Sub

~'J'~

[Ed Jobe]

If you are drawing the lines in vba, just keep track of the last object you created and add to it. You say you are drawing lines. Use the endpoint of the last object as the startpoint of the next one. If you need to work with plines, keep that and add to its vertices.

[rwbaker54]

sounds like I should be using a polyline instead of drawing indivadual lines.

thru vba when using a polyline to draw with how do you go from a straight line to an arc?

[seant61]

Look at the "SetBulge" method - unfortunately it is not particularly intuitive (neither, for that matter, are polylines in general). If you encounter trouble, post a follow up as someone here is bound to have a suggestion.

[MikeJarosz]

Look at the "SetBulge" method - unfortunately it is not particularly intuitive (neither, for that matter, are polylines in general).

You can say that again, Sean. You saved me twice when I needed the z coordinate of a poly vertex.

[seant61]

Mike, as I recall you were working on some intersting projects at the time. There was a revamp of a "Sun angle analysis" routine. How goes the progress on that? Also, there was a rather complex sculptured roof, I don't suppose they've broke groun-, uhm, . . . .sky . . . . on that project yet, have they?

[MikeJarosz]

I got all the subroutines written... cross product, dot product, parrallelopiped etc, etc, etc, but the routine that connects them all never happened. I was reassigned to Revit API development, something I really wanted to do. Since we already have a system running in LISP, we decided I should spend my time doing something we don't already have.