Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Line between two lines

42 REPLIES 42
SOLVED
Reply
Message 1 of 43
smaher12
10170 Views, 42 Replies

Line between two lines

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 "")
)

42 REPLIES 42
Message 2 of 43
Kent1Cooper
in reply to: smaher12


@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 nested in Blocks or Xrefs or nested further than that [e.g. edges of Dimension arrowheads].  It even checks whether what you select is straight and has linearity [e.g. it will reject Polyline arc segments, Circles, Arcs, Splines, Text, etc.].

 

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.]

Kent Cooper, AIA
Message 3 of 43
_Tharwat
in reply to: smaher12

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
pbejse
in reply to: smaher12

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
hmsilva
in reply to: smaher12

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

EESignature

Message 6 of 43
pbejse
in reply to: hmsilva


@hmsilva wrote:

 

@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


Good point

 

(defun c:l2 (/ mid _nonz lines 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
phanaem
in reply to: smaher12

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 8 of 43
hmsilva
in reply to: pbejse

pbejse,

the "_nonz" function,  simple and clean solution.  Smiley Happy

 

Cheers

Henrique

EESignature

Message 9 of 43
smaher12
in reply to: hmsilva

I thank all of you. Definitely more than one way to skin a cat. Very clever indeed. Thanks again.

Message 10 of 43
hmsilva
in reply to: smaher12

You're welcome, smaher12

EESignature

Message 11 of 43
pbejse
in reply to: smaher12


@smaher12 wrote:

I thank all of you. Definitely more than one way to skin a cat. Very clever indeed. Thanks again.


Glad we could hep 🙂


@hmsilva wrote:

pbejse,

the "_nonz" function,  simple and clean solution.  Smiley Happy

 

Cheers

Henrique


Thank you for your kind words Henrique 🙂

 

Message 12 of 43
Kent1Cooper
in reply to: smaher12

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

Kent Cooper, AIA
Message 13 of 43
hmsilva
in reply to: Kent1Cooper

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...

 

 

Line between two lines.PNG

 

EDITED

image of the test with the last code.

 

Henrique

EESignature

Message 14 of 43
Kent1Cooper
in reply to: hmsilva


@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

 

Kent Cooper, AIA
Message 15 of 43
hmsilva
in reply to: Kent1Cooper

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

EESignature

Message 16 of 43
Kent1Cooper
in reply to: hmsilva


@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.

Kent Cooper, AIA
Message 17 of 43
hmsilva
in reply to: Kent1Cooper

Kent Cooper,

as usual, a very good code!

 

Henrique

EESignature

Message 18 of 43
Kent1Cooper
in reply to: hmsilva


@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.

Kent Cooper, AIA
Message 19 of 43
pbejse
in reply to: Kent1Cooper


@Kent1Cooper wrote:

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

 


Smiley LOL I do that myself sometimes

 

 

Message 20 of 43
smaher12
in reply to: pbejse


 


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???

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

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report