Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Mentor
smaher12
Posts: 173
Registered: ‎11-20-2011
Message 1 of 26 (1,356 Views)
Accepted Solution

Line between two lines

1356 Views, 25 Replies
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 "")
)

*Expert Elite*
Kent1Cooper
Posts: 5,368
Registered: ‎09-13-2004
Message 2 of 26 (1,341 Views)

Re: Line between two lines

02-15-2013 10:24 AM 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
Distinguished Mentor
_Tharwat
Posts: 599
Registered: ‎07-02-2010
Message 3 of 26 (1,327 Views)

Re: Line between two lines

02-15-2013 11:23 AM 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)
)

 

____________________________________________________
Get learn and learn and practice , to become experienced guy .
*Expert Elite*
pbejse
Posts: 2,459
Registered: ‎11-24-2009
Message 4 of 26 (1,306 Views)

Re: Line between two lines

02-16-2013 06:25 AM in reply to: smaher12

For fun and to give you something to think about :smileyhappy:

 

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

 

 

*Expert Elite*
hmsilva
Posts: 2,745
Registered: ‎12-17-2004
Message 5 of 26 (1,287 Views)

Re: Line between two lines

02-16-2013 02:41 PM 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

*Expert Elite*
pbejse
Posts: 2,459
Registered: ‎11-24-2009
Message 6 of 26 (1,279 Views)

Re: Line between two lines

02-16-2013 07:29 PM 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)
                 )

 

 

Distinguished Contributor
phanaem
Posts: 149
Registered: ‎02-06-2007
Message 7 of 26 (1,264 Views)

Re: Line between two lines

02-17-2013 04:18 AM 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)
)

 

*Expert Elite*
hmsilva
Posts: 2,745
Registered: ‎12-17-2004
Message 8 of 26 (1,255 Views)

Re: Line between two lines

02-17-2013 06:10 AM in reply to: pbejse

pbejse,

the "_nonz" function,  simple and clean solution.  :smileyhappy:

 

Cheers

Henrique

Mentor
smaher12
Posts: 173
Registered: ‎11-20-2011
Message 9 of 26 (1,214 Views)

Re: Line between two lines

02-19-2013 10:15 AM in reply to: hmsilva

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

*Expert Elite*
hmsilva
Posts: 2,745
Registered: ‎12-17-2004
Message 10 of 26 (1,199 Views)

Re: Line between two lines

02-19-2013 11:50 AM in reply to: smaher12

You're welcome, smaher12

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.