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
Solved! Go to Solution.
Solved by Charles_Shade. Go to 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.
_____________________________________________________________
Regards, Charles Shade
CSHADEDESIGN | AUTOCAD LT | LT-KB | DYNAMIC BLOCKS
Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
That is a nice command, easier to use then the standard Break command.
thanks.
-Joe
Someone wrote that on basically the same request you had.
Don't recall who it was but glad it could help.
Regards, Charles Shade
CSHADEDESIGN | AUTOCAD LT | LT-KB | DYNAMIC BLOCKS
Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
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
Does that one cause a Gap to open after the first use?
Regards, Charles Shade
CSHADEDESIGN | AUTOCAD LT | LT-KB | DYNAMIC BLOCKS
Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
@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
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.
Regards, Charles Shade
CSHADEDESIGN | AUTOCAD LT | LT-KB | DYNAMIC BLOCKS
Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
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
At some point I'll need to put the Button back to original then.
Regards, Charles Shade
CSHADEDESIGN | AUTOCAD LT | LT-KB | DYNAMIC BLOCKS
Please mark Accept as Solution if your question is answered. Kudos gladly accepted. ⇘
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.
'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
Can't find what you're looking for? Ask the community or share your knowledge.