- Forums Home
- >
- AutoCAD Community
- >
- AutoCAD Customization Forum
- >
- Visual LISP, AutoLISP and General Customization forum
- >
- Line between two lines

Community

Visual LISP, AutoLISP and General Customization

Turn on suggestions

Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.

This page has been translated for your convenience with an automatic translation service. This is not an official translation and may contain errors and inaccurate translations. Autodesk does not warrant, either expressly or implied, the accuracy, reliability or completeness of the information translated by the machine translation service and will not be liable for damages or losses caused by the trust placed in the translation service.
Translate

Topic Options

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page

Message 1 of 43

02-15-2013
08:55 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-15-2013
08:55 AM

I am trying to draw a line between two lines and I put together the following. It works great if the start/end points are perpendicular to each other. How do I solve if line one start point is in a positive direction and line two is in a negative direction?

(defun c:test ()

(setq L1 (car (entsel "\nSelect the first line: "))

L2 (car (entsel "\nSelect the second line: "))

)

(setq P1 (cdr (assoc 10 (entget L1)))

P2 (cdr (assoc 11 (entget L1)))

P3 (cdr (assoc 10 (entget L2)))

P4 (cdr (assoc 11 (entget L2)))

)

(setq D1 (/ (distance P1 P3) 2)

D2 (/ (distance P2 P4) 2)

)

(setq A1 (angle P1 P3)

A2 (angle P2 P4)

)

(setq P5 (polar P1 A1 D1)

P6 (polar P2 A2 D2)

)

(command "LINE" P5 P6 "")

)

Solved! Go to Solution.

Solved by Kent1Cooper. Go to Solution.

Solved by pbejse. Go to Solution.

Solved by _Tharwat. Go to Solution.

42 REPLIES 42

Message 2 of 43

02-15-2013
10:24 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-15-2013
10:24 AM

@smaher12 wrote:I am trying to draw a line between two lines and I put together the following. It works great if the start/end points are perpendicular to each other. How do I solve if line one start point is in a positive direction and line two is in a negative direction?

(defun c:test ()

(setq L1 (car (entsel "\nSelect the first line: "))

L2 (car (entsel "\nSelect the second line: "))

)(setq P1 (cdr (assoc 10 (entget L1)))

P2 (cdr (assoc 11 (entget L1)))

P3 (cdr (assoc 10 (entget L2)))

P4 (cdr (assoc 11 (entget L2)))

)(setq D1 (/ (distance P1 P3) 2)

D2 (/ (distance P2 P4) 2)

)(setq A1 (angle P1 P3)

A2 (angle P2 P4)

)(setq P5 (polar P1 A1 D1)

P6 (polar P2 A2 D2)

)

(command "LINE" P5 P6 "")

)

If you don't mind a routine that draws an *Xline* [which you would then presumably want to Break or Trim somehow], there's a **Bisector** command in Bisector.lsp here. It will draw an Xline bisecting the *angle* between any two *non-parallel*, or centered in the *distance* between any two *parallel*, straight things ** of any kind** -- works with Lines, Polyline [of any variety] line segments, Xlines, Rays, pieces of Hatch patterns, Dimension extension lines or linear-Dimension dimension lines, straight Leader segments, straight edges of 3DSolids/Regions, edges of 2DSolids/3Dfaces/Traces/Wipeouts/Image frames/Viewports/Tolerance boxes, or any such things

But if you need to do it more like your approach, I would suggest testing whether the starting end of one selected Line is closer to the start or the end of the other Line. And if you don't mind a suggested simplification, there is a much more concise way to find the midpoints between their endpoints, by "averaging" their locations, eliminating the need for several of your variables.

Try this [minimally tested]:

(defun c:test ()

(setq

L1 (car (entsel "\nSelect the first line: "))

L2 (car (entsel "\nSelect the second line: "))

P1 (cdr (assoc 10 (entget L1)))

P2 (cdr (assoc 11 (entget L1)))

P3 (cdr (assoc 10 (entget L2)))

P4 (cdr (assoc 11 (entget L2)))

); setq

(if (< (distance P1 P4) (distance P1 P3))

(setq ; then -- reverse second-line point locations

P3 (cdr (assoc 11 (entget L2)))

P4 (cdr (assoc 10 (entget L2)))

); setq

); if

(command

"LINE"

"_none" (mapcar '/ (mapcar '+ P1 P3) '(2 2 2))

"_none" (mapcar '/ (mapcar '+ P2 P4) '(2 2 2))

""

); command

); defun

[EDIT: -- added the "_none" Osnap calls, just in case; you could instead turn Osnap off as part of the routine.]

Message 3 of 43

02-15-2013
11:23 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-15-2013
11:23 AM

Try this ...

(defun c:MidLine (/ _Mid l1 l2 pt1 pt2 pt3 pt4) ;;; Tharwat 15. Feb. 2013 ;;; (defun _Mid (p1 p2) (mapcar '(lambda (j k) (/ (+ j k) 2.)) p1 p2) ) (if (and (setq l1 (car (entsel "\n Select the first line: "))) (if (not (eq (cdr (assoc 0 (entget l1))) "LINE")) (progn (princ "\n Your first selection is not a LINE <!>") nil ) t ) (setq l2 (car (entsel "\nSelect the second line: "))) (if (not (eq (cdr (assoc 0 (entget l2))) "LINE")) (progn (princ "\n Your Second selection is not a LINE <!>") nil ) t ) ) (progn (setq pt1 (cdr (assoc 10 (entget l1))) pt2 (cdr (assoc 11 (entget l1))) pt3 (cdr (assoc 10 (entget l2))) pt4 (cdr (assoc 11 (entget l2))) ) (if (inters pt1 pt3 pt2 pt4) (setq pt3 (cdr (assoc 11 (entget l2))) pt4 (cdr (assoc 10 (entget l2))) ) ) (entmakex (list '(0 . "LINE") (cons 10 (_Mid pt1 pt3)) (cons 11 (_Mid pt2 pt4)) ) ) ) (princ) ) (princ) )

Message 4 of 43

02-16-2013
06:25 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-16-2013
06:25 AM

For fun and to give you something to think about 🙂

(defun c:l2 (/ mid lines p) (setq mid (lambda (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))) (while (and (setq lines (ssget '((0 . "LINE")))) (= (sslength lines) 2)) (setq p (mapcar '(lambda (i) (list (cdr (Assoc 10 i)) (cdr (assoc 11 i)))) (list (entget (ssname lines 0)) (entget (ssname lines 1))))) (setq p (if (inters (caar p) (caadr p) (cadar p) (cadadr p)) (list (car p)(reverse (cadr p))) p)) (entmakex (list '(0 . "LINE") (cons 10 (mid (caar p)(caadr p))) (cons 11 (mid (cadar p)(cadadr p)))))) (princ) )

Message 5 of 43

02-16-2013
02:41 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-16-2013
02:41 PM

smaher12,

just one more way

(defun c:test (/ l1 l2 p1 p2 p3 p4) (setq l1 (car (entsel "\nSelect the first line: ")) l2 (car (entsel "\nSelect the second line: ")) p1 (cdr (assoc 10 (entget l1))) p2 (cdr (assoc 11 (entget l1))) p3 (cdr (assoc 10 (entget l2))) p4 (cdr (assoc 11 (entget l2))) );; setq (if (inters (list (car p1) (cadr p1)) (list (car p3) (cadr p3)) (list (car p2) (cadr p2)) (list (car p4) (cadr p4)) );; inters (vl-cmdf "line" "m2p" p1 p4 "m2p" p2 p3 "") (vl-cmdf "line" "m2p" p1 p3 "m2p" p2 p4 "") );; if ); test

@Tharwat

@pbejse

if the lines are 3D lines the inters function, will not find the interception, because,

in inters, if the four points arguments are 3D, inters checks for 3D intersection...

Henrique

Message 6 of 43

02-16-2013
07:29 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-16-2013
07:29 PM

@hmsilva wrote:

if the lines are 3D lines the inters function, will not find the interception, because,

in inters, if the four points arguments are 3D, inters checks for 3D intersection...

Henrique

Good point

(defun c:l2 (/ mid_nonzlines p) (setq mid (lambda (p1 p2) (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5))))(setq _nonz (lambda (l)(list (car l)(cadr l))))(while (and (setq lines (ssget '((0 . "LINE")))) (= (sslength lines) 2)) (setq p (mapcar '(lambda (i) (list (cdr (Assoc 10 i)) (cdr (assoc 11 i)))) (list (entget (ssname lines 0)) (entget (ssname lines 1))))) (setq p (if((lambda (ls) (apply 'inters (list (car ls) (caddr ls) (cadr ls) (cadddr ls)))) (mapcar '_nonz (append (car p)(cadr p))))(list (car p)(reverse (cadr p))) p)) (entmakex (list '(0 . "LINE") (cons 10 (mid (caar p)(caadr p))) (cons 11 (mid (cadar p)(cadadr p)))))) (princ) )

Message 7 of 43

02-17-2013
04:18 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-17-2013
04:18 AM

Another one.

It is user's responsibility to choose the correct part of lines.

(like in Trim, Extend, Fillet etc)

(defun C:TEST (/ s1 s2 l1 l2 pts) (if (and ; - add here error trap for no selection or for entity type (setq s1 (entsel "\nSelect first line: ")) (setq s2 (entsel "\nSelect second line: ")) ) (progn (setq l1 (get_points s1) l2 (get_points s2) pts (mapcar 'mid l1 l2) ) (entmake (list '(0 . "LINE") ;;; (cons 8 "Layer") (cons 10 (car pts)) (cons 11 (cadr pts)) ) ) ) ) (princ) ) (defun get_points (s / e p p1 p2) (setq e (car s) p (vlax-curve-getClosestPointTo e (cadr s)) p1 (vlax-curve-getStartPoint e) p2 (vlax-curve-getEndPoint e) ) (if (< (distance p p1) (distance p p2)) (list p1 p2) (list p2 p1) ) ) (defun mid (p1 p2) (mapcar '(lambda (a b) (* 0.5 (+ a b))) p1 p2) )

Message 11 of 43

02-19-2013
08:23 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

Message 12 of 43

02-20-2013
05:49 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-20-2013
05:49 AM

If you can stand another approach [I kept daydreaming about it -- is there something wrong with me?]....

This one uses an undocumented (ssget) mode trick [the +.] that I think I learned from Lee Mac a while back, which keeps (ssget) in "point" mode [no going into Window/Crossing if picked in an empty area], making it easy to have it *keep asking* the User to select a Line until they actually do, *without* having to dig into entity data to check -- it asks again if they miss *or* if they pick some other object type. And by using the (set) function, it can employ the *same* stretch of code to do this for *both* Lines, rather than spelling it out individually for each one as in _Tharwat's code in Message 3. Also, it doesn't *re-set* any point locations if the Lines run in opposite directions, but simply uses the end of the second Line appropriate to the direction it runs relative to the first Line, right inside the calculations of the endpoints of the new Line. The one thing I wish could be different is that (ssget) always uses the "Select objects: " prompt, in the *plural*, which you can't override, so I made a sort-of work-around, mostly so you can tell when you've successfully picked a first Line, because it's asking for Line 2.

(defun C:LB (/ ss lin ed s1 e1 s2 e2 int); = Line Between

(prompt "\nTo draw a Line halfway between two Lines,")

(foreach num '(1 2)

(prompt (strcat "\nFor Line " (itoa num) ","))

(while

(not (setq ss (ssget "_+.:E:S" '((0 . "LINE")))))

(prompt (strcat "\nNothing selected, or not a Line. For Line " (itoa num) ","))

); while

(setq lin (ssname ss 0)); [line]

(setq ed (entget lin)); [entity data]

(set (read (strcat "s" (itoa num))) (cdr (assoc 10 ed))); s1 or s2 [start]

(set (read (strcat "e" (itoa num))) (cdr (assoc 11 ed))); e1 or e2 [end]

); foreach

(setq int (inters s1 s2 e1 e2)); T or nil -- opposite directions *[assumes same plane]*

(entmake

(list

'(0 . "LINE")

(cons 10 (mapcar '/ (mapcar '+ s1 (if int e2 s2)) '(2 2 2)))

(cons 11 (mapcar '/ (mapcar '+ e1 (if int s2 e2)) '(2 2 2)))

); list

); entmake

); defun

Message 13 of 43

02-20-2013
07:30 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-20-2013
07:30 AM

Kent1Cooper wrothe:

...

This one uses an undocumented (ssget) mode trick [the +.] that I think I learned from Lee Mac a while back, which keeps (ssget) in "point" mode [no going into Window/Crossing if picked in an empty area], making it easy to have it keep asking the User to select a Line until they actually do, without having to dig into entity data to check -- it asks again if they miss or if they pick some other object type.

...

The one thing I wish could be different is that (ssget) always uses the "Select objects: " prompt, in the plural, which you can't override, so I made a sort-of work-around, mostly so you can tell when you've successfully picked a first Line, because it's asking for Line 2.

...

Excellent way to use the "ssget", and be able to use a message during selection.

hmsilva wrothe:

...

@Tharwat

if the lines are 3D lines the inters function, will not find the interception, because,

in inters, if the four points arguments are 3D, inters checks for 3D intersection...

as I had written in message 5, the "inters" function gives an error if the points are 3D points...

EDITED

image of the test with the last code.

Henrique

Message 14 of 43

02-20-2013
08:42 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-20-2013
08:42 AM

@hmsilva wrote:....

as I had written in message 5, the "inters" function gives an error if the points are 3D points...

....

Yes, that's why I put *[assumes same plane]* in there -- I was focusing on other elements. [It's not that (inters) gives an *error*, but just that it returns nil, so the routine assumes the Lines are running in the same direction when they are not, and it averages the locations between the wrong ends of the selected Lines.] But this takes care of that, in limited testing, using a slightly different approach [(defun) rather than (setq)] to pbejse's _nonz function. [And I'm putting it in a code window this time because of the colon-followed-by-S element, so it won't be a smiley for those who don't have those turned off.] Also, it works without the :E I had in the (ssget) mode before.

(defun C:LB (/ noZ ss lin ed s1 e1 s2 e2 int); = Line Between (defun noZ (pt) (list (car pt) (cadr pt))) (prompt "\nTo draw a Line halfway between two Lines,") (foreach num '(1 2) (prompt (strcat "\nFor Line " (itoa num) ",")) (while (not (setq ss (ssget "_+.:S" '((0 . "LINE"))))) (prompt (strcat "\nNothing selected, or not a Line. For Line " (itoa num) ",")) ); while (setq lin (ssname ss 0)); [line] (setq ed (entget lin)); [entity data] (set (read (strcat "s" (itoa num))) (cdr (assoc 10 ed))); s1 or s2 [start] (set (read (strcat "e" (itoa num))) (cdr (assoc 11 ed))); e1 or e2 [end] ); foreach (setq int (inters (noZ s1) (noZ s2) (noZ e1) (noZ e2))); T or nil -- opposite directions (entmake (list '(0 . "LINE") (cons 10 (mapcar '/ (mapcar '+ s1 (if int e2 s2)) '(2 2 2))) (cons 11 (mapcar '/ (mapcar '+ e1 (if int s2 e2)) '(2 2 2))) ); list ); entmake ); defun

Message 15 of 43

02-20-2013
09:14 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-20-2013
09:14 AM

Kent Cooper,

the mistake was mine, only after having placed the post, I read the [assumes same plane], my apologies.

One more thing, when I wrote, gives error, in relation to the "inters" function, what I meant was that the function looks for a true intersection if are given 3D points, as this case is just to test the direction the lines were created, gives error not finding the intersection, so to use the "inters" function, in this case, we have to provide 2D points.

Henrique

Message 16 of 43

02-20-2013
11:01 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-20-2013
11:01 AM

@hmsilva wrote:.... the function looks for a true intersection if are given 3D points, as this case is just to test the direction the lines were created, gives error not finding the intersection, so to use the "inters" function, in this case, we have to provide 2D points.

....

It would, of course, work with 3D points, if they're all in a common plane. I considered forcing them to be like that by including a Z component of 0 in each point for the (inters) test, that is, in place of doing this:

(defun **noZ** (pt) (list (car pt) (cadr pt)))

doing this instead:

(defun **Z0** (pt) (list (car pt) (cadr pt) **0**))

But I found that the X & Y components are enough, so I left it that way.

Then I played around and found some interesting things. If I did a series of them, and then typed U, it undid *everything* back to the previous regular AutoCAD command [in this instance, the APPLOAD that brought in the command definition], meaning it took away *all* of the halfway-between Lines I had made, together. So I added undo beginning and ending within the routine, so you can undo one at a time. And because of that, I added error handling to make sure the undo ending happens, in case something goes wrong or you cancel it [e.g. hit Esc when it's asking for the second Line], so you won't be left with an undo beginning that doesn't have an ending.

I also found that it doesn't work quite as expected under some circumstances with Lines that intersect or if one overlaps their apparent/virtual intersection. But I let that stand, because it could be impossible for the routine to determine what "should" be the expected result in a lot of situations. See notes at the top of the attached.

Message 17 of 43

02-20-2013
11:20 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

Message 18 of 43

02-20-2013
12:15 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-20-2013
12:15 PM

@hmsilva wrote:Kent Cooper,

as usual, a very good code!

Henrique

Thank you. I will sometimes "go all the way" like that with something if I think we'll have a use for it around here. This one, maybe we won't have all that *much* use for, but we'll see -- just knowing it's available may reveal that a situation like that arises more often than I think.

Message 19 of 43

02-20-2013
07:30 PM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

02-20-2013
07:30 PM

@Kent1Cooper wrote:If you can stand another approach [

I kept daydreaming about it -- is there something wrong with me?]....

I do that myself sometimes

Message 20 of 43

03-01-2013
10:49 AM

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report

03-01-2013
10:49 AM

Kent1Cooper wrote:

If you can stand another approach [**I kept daydreaming about it -**- is there something wrong with me?]....

I was just thinking, what if you wanted to include polylines???

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page

Can't find what you're looking for? Ask the community or share your knowledge.