break at intersection command

[jhjirak]

Is there a command that would break lines at intersections automatically? 

I know there is such a command in autocad map 3D, but is there a way to do it in LT?  With a macro?

I have attached a picture of the parcels that I like to break at each intersection has an example. 

Then I go on to use the OVERKILL command which works very well.

Any help would be appreciated.

-Joe

[Charles_Shade · Accepted solution]

I've used this for years though it does require the line to be broken and the point to be broken at

to both be chosen. May be what always has to be done

*^C^Cbreak;\f;int;\@;

Please mark any response as "Accept as Solution" if it answers your question.
_____________________________________________________________

[jhjirak]

That is a nice command, easier to use then the standard Break command. 

thanks.

-Joe

[Charles_Shade]

Someone wrote that on basically the same request you had.

Don't recall who it was but glad it could help.

[drjohn]

The BREAK @ point command in the Ribbon is a good one also. Problem is that it stops after one break.  To solve that issue, put an asterisk in front of the command in the CUI and it will repeat until you hit ESC.

FWIW

Regards,

DJ

[Charles_Shade]

Does that one cause a Gap to open after the first use?

[drjohn]

---

@Charles_Shade wrote:

Does that one cause a Gap to open after the first use?

---

I'm guessing a what you are asking, but the asterisk only makes the command repeat until ESC.  It only does the same as

break;

f;

int;

@

There is no gap in the line, it just splits the line at the intersection (or other location) I choose and 2 lines remain.

The benefit here for me is that I do many of those a a time and don't want to hit the command icon again or type the command several times.

Works for me.  YMMV  (that's the second time I used that expression in the same thread ... LMAO)

Regards,

DJ

[Charles_Shade]

2005(?) Versions when you used the Break Command multiple times it would do nothing more than you describe: Break the line but the two ends still touched.

2008(?) when you did this break with the * the first break point would keep the ends touching but the next break would open up a Gap. The Gap became successively larger the more you did.

The attached Macro was a workaround for that behavior.

It may be that the current version does not cause the Gap but what I got works for me.

[drjohn]

Actually, the BREAK@point command from the ribbon is the same as your macro. No gaps.  the F sets the first point which is your intersection or whatever and the @ splits the line. No Gaps ... no runs ... no errors. 

Regards,

DJ

[pendean]

I wondered why there was a macro for an existing tool already in the menus and ribbon... .

[Charles_Shade]

At some point I'll need to put the Button back to original then.

[WORKPLAYLOVE]

Thanks Charles! You're the man!

True, you can use "break", then type "int", then select the line, then type "@", then press enter to break it at the point but the command doesn't stay active and takes more steps.

With your macro its just a click then a second click, lol. Perfect.

[ozgun.sen]

hello

Where do we put this in autocad *^C^Cbreak;\f;int;\@;

[pendean]

Explore these topics
http://www.cadalyst.com/cad/autocad/create-your-own-autocad-commands-circles-and-lines-autocad-tutor...
and
https://www.wikihow.com/Create-a-New-Command-on-Autocad

[meercats_jcd]

if you dont mind..
select all intersecting lines and polylines and explode..
purge and save it as dwg file...
Save it again but as a dxf file...
Open staad pro..
import/export dxf..
Structure Convention, chose Y Up..
Choose appropriate Units..
Select all lines in staad pro..
in Geometry Tab select INTERSECT SELECTED BEAMS..
in the File Tab selct IMPORT/EXPORT..
Export as 3D DXF File..
Provide File name for the dxf file..
in Structure convention, chose Z UP..
Open in autocad the generated dxf file from staad and remove all unnecessary text..

may it helps you..

[steven-g]

@meercats_jcd

This makes absolutely no sense at all to me, and besides, it is replying to a 6 year old post, or are you just trying to advertise something?

[junsok73]

'Use this VBA code.

'Only avaliable to line elements.

'1. Draw lines to split at each joints.

'2. call this "BL" function

'3. That's all.

'Function BL is the main program.

'============================================================================================
'Break_Line main program
'============================================================================================
Function BL()
On Error Resume Next

Set osel = SelectionSetFromScreen
Set osel2 = osel

kk = 0
For Each ent1 In osel
strs = ""
For Each ent2 In osel2
xp = ""
xp = double2string(ent1.IntersectWith(ent2, acExtendNone))
If xp <> "" Then
strs = strs & xp & vbCrLf
End If
Next

strs = strs & double2string(ent1.EndPoint)

x0 = ent1.StartPoint
cc = string2doublen(strs, 3)

strs = ""
For i = 0 To UBound(cc, 1)
strs = strs & VectorSize(x0, string2double(cc(i, 0) & " " & cc(i, 1) & " " & cc(i, 2))) & vbCrLf
Next i

aa = sortArray(string2double(strs))


For i = 0 To UBound(cc, 1)
k0 = aa(i)
x1 = string2double(cc(k0, 0) & " " & cc(k0, 1) & " " & cc(k0, 2))

If VectorSize(x0, x1) > 0.0000000001 Then
Set lineObj = ThisDrawing.ModelSpace.AddLine(x0, x1)
x0 = x1
Else
x0 = x0
End If

Next i
Next

For Each ent In osel
ent.Delete
Next

ThisDrawing.Regen (True)

End Function

'============================================================================================
'return selection set
'============================================================================================
Function SelectionSetFromScreen(Optional ww As String) As AcadSelectionSet

On Error Resume Next

selsname = "S_" & IntRandomCall(1, 10000000#)

ThisDrawing.SelectionSets(selsname).Delete
Set SelectionSetFromScreen = ThisDrawing.SelectionSets.Add(selsname)
SelectionSetFromScreen.SelectOnScreen

End Function

'============================================================================================
'change double array to string
'============================================================================================
Function double2string(ar) As String
For i = 0 To UBound(ar)
double2string = double2string & ar(i) & " "
Next

double2string = RTrim(double2string)

End Function

'============================================================================================
'vector size
'============================================================================================
Function VectorSize(p0, p1) As Double 'vector_size vector size
a1 = p1(0) - p0(0)
a2 = p1(1) - p0(1)
a3 = p1(2) - p0(2)

VectorSize = (a1 ^ 2 + a2 ^ 2 + a3 ^ 2) ^ 0.5

End Function

'============================================================================================
'array sort
'============================================================================================
Function sortArray(a, Optional identifier = "up") As Long()

n1 = LBound(a)
n2 = UBound(a)

Dim nn() As Long
ReDim nn(n2) As Long

For i = n1 To n2
nn(i) = i
Next i


If LCase(identifier) = "dn" Then
For i = n1 To n2
a0 = a(i)
For j = n1 To n2
a1 = a(j)
If a0 > a1 Then
a(i) = a1
a(j) = a0
a0 = a1

kk = nn(j)
nn(j) = nn(i)
nn(i) = kk


End If
Next j
Next i
Else
For i = n1 To n2
a0 = a(i)
For j = n1 To n2
a1 = a(j)
If a0 < a1 Then
a(i) = a1
a(j) = a0
a0 = a1

kk = nn(j)
nn(j) = nn(i)
nn(i) = kk


End If
Next j
Next i
End If

sortArray = nn

End Function

'============================================================================================
'split string to array
'============================================================================================
Function string2double(ByVal ss As String) As Double()

On Error Resume Next
Dim cc() As Double

ss = Replace(ss, vbTab, " ")
ss = Replace(ss, ",", " ")
ss = Replace(ss, ";", " ")
ss = Replace(ss, "(", " ")
ss = Replace(ss, ")", " ")
ss = Replace(ss, "\", " ")
ss = Replace(ss, "|", " ")
ss = Replace(ss, vbCrLf, " ")


qq = Split(ss)

kk = 0
For i = 0 To UBound(qq)
If IsNumeric(qq(i)) Then
kk = kk + 1
End If
Next i



ReDim cc(kk - 1)
kk = 0
For i = 0 To UBound(qq)
If IsNumeric(qq(i)) Then
cc(kk) = qq(i)
kk = kk + 1
End If
Next i

string2double = cc

Exit Function

'errh:
' MsgBox "ERR!!!"

End Function

'============================================================================================
'split string to n-dimensional array
'============================================================================================
Function string2doublen(strs, n) As Double()

ss = string2double(strs)

n1 = LBound(ss)
n2 = UBound(ss)
nn = (n2 - n1 + 1) / n

Dim cc() As Double
ReDim cc(nn - 1, n - 1) As Double

kk = 0
For i = 0 To nn - 1
For j = 0 To n - 1
cc(i, j) = ss(kk)
kk = kk + 1
Next
Next

string2doublen = cc


End Function

'============================================================================================
'randomize integer
'============================================================================================
Function IntRandomCall(n1, n2)
Randomize
IntRandomCall = Int((n2 - n1 + 1) * Rnd + n1)
End Function

[steven-g]

@junsok73 That code probably works really well, just not in Autocad LT as it doesn't support programming languages or addins 

[junsok73]

Haha. I didnt know. I am just using normal autocad.

[LSISTO]

1. COMMAND: "MAPCLEAN"
2. SELECT ALL OR MANUALLY SELECT OBJECTS
3. SELECT "BREAK CROSSING OBJECTS" AND "ADD"
4. SELECT YOUR PREFERRED CLEANUP METHODS
5. FINISH