Extend line perpendicular to point

[Jozef13]

Dear all,

I am looking for a lisp that extend selected line perpendicular to picked point as shown in the picture.

[Tharwat]

Give this a shot.  

(defun c:Test (/ s e p a b g x d)
  ;; Tharwat - 10.Feb.2021	;;
  (and
    (setq
      s (car (entsel "\nSelect line to extend to desired point : "))
    )
    (or (= (cdr (assoc 0 (setq e (entget s)))) "LINE")
        (alert "Invalid object. Please select line object.")
    )
    (or
      (/= 4
          (logand
            4
            (cdr
              (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))
            )
          )
      )
      (alert
        (strcat "Select line object resides on a LOACKED layer <!>")
      )
    )
    (setq p (getpoint
              "\nSpecify a point to extend the previously line to : "
            )
    )
    (setq a (cdr (assoc 10 e))
          b (cdr (assoc 11 e))
          g (angle a b)
    )
    (vl-some '(lambda (u)
                (setq x (inters a b p (polar p (eval u) 1.0) nil))
              )
             '((+ g (* pi 0.5)) (+ g pi))
    )
    (setq d (if (< (distance x a) (distance x b))
              10
              11
            )
    )
    (entmod (subst (cons d x) (assoc d e) e))
  )
  (princ)
)

 

[Jozef13]

1 hour ago, Tharwat said:

Give this a shot.  

(defun c:Test (/ s e p a b g x d)
  ;; Tharwat - 10.Feb.2021	;;
  (and
    (setq
      s (car (entsel "\nSelect line to extend to desired point : "))
    )
    (or (= (cdr (assoc 0 (setq e (entget s)))) "LINE")
        (alert "Invalid object. Please select line object.")
    )
    (or
      (/= 4
          (logand
            4
            (cdr
              (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))
            )
          )
      )
      (alert
        (strcat "Select line object resides on a LOACKED layer <!>")
      )
    )
    (setq p (getpoint
              "\nSpecify a point to extend the previously line to : "
            )
    )
    (setq a (cdr (assoc 10 e))
          b (cdr (assoc 11 e))
          g (angle a b)
    )
    (vl-some '(lambda (u)
                (setq x (inters a b p (polar p (eval u) 1.0) nil))
              )
             '((+ g (* pi 0.5)) (+ g pi))
    )
    (setq d (if (< (distance x a) (distance x b))
              10
              11
            )
    )
    (entmod (subst (cons d x) (assoc d e) e))
  )
  (princ)
)

 

Thank you very much for your prompt solution.

I works perfect in 2D or in the same z-coordinate of both line and point.

If I move line in Z-coord. it doesn't work and in my dwg where I want to extend it to circle I obtain alert: "Oblique, non-uniformly scaled objects were ignored."

It probably needs to ignore Z-coord of desired point.

I enclosed part of my dwg.

Extend_2.dwg

[tombu]

Just pick the grip of the line you want to extend, right-click and select Extend, then pick the point.

Easy-peasy!

[JerryFiedler]

tombu, You are correct in that you do not need a lisp routine to extend the line.  I noticed the OP is using AutoCAD 2016; so do I.  For us right clicking on the line's grip does not reveal "Extend" in the context menu.  However when I select a grip a box appears with "Stretch" and "Lengthen".  Clicking on "Lengthen" and then picking the desired point to which you want to extend the line does exactly what we want.  This works regardless of the value of the Z's.  As you say easy-peasy!

[Jozef13]

I have modified z-coordinate of p-point by z- coord of line point and it works.

Both end points of line must have equal z-coordinate.

(defun c:ExtL (/ s e p a b g x d)
  ;; Tharwat - 10.Feb.2021	;;
  (and
    (setq
      s (car (entsel "\nSelect line to extend to desired point : "))
    )
    (or (= (cdr (assoc 0 (setq e (entget s)))) "LINE")
        (alert "Invalid object. Please select line object.")
    )
    (or
      (/= 4
          (logand
            4
            (cdr
              (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8
e)))))
            )
          )
      )
      (alert
        (strcat "Select line object resides on a LOACKED layer
<!>")
      )
    )
    (setq p (getpoint
              "\nSpecify a point to extend the previously line to :
"
            )
    )
    (setq a (cdr (assoc 10 e))
          b (cdr (assoc 11 e))
          g (angle a b)
    )
;;;    Redefine z-coord of p-point
    (setq p (list (car p) (cadr p) (caddr a)))
    
    (vl-some '(lambda (u)
                (setq x (inters a b p (polar p (eval u) 1.0) nil))
              )
             '((+ g (* pi 0.5)) (+ g pi))
    )
    (setq d (if (< (distance x a) (distance x b))
              10
              11
            )
    )
    (entmod (subst (cons d x) (assoc d e) e))
  )
  (princ)
)

 

[Guest]

Hi Tharwat. Nice code. Is it possible to do some changes to the code ?

1) I want to pick first the point and then to give me the option to extend multiple lines

2) to pick first the point and then to give me the option to trim multiple lines as Test2 lisp code

 

(defun c:Test (/ s e p a b g x d)
  ;; Tharwat - 10.Feb.2021	;;
  (and
    (setq
      s (car (entsel "\nSelect line to extend to desired point : "))
    )
    (or (= (cdr (assoc 0 (setq e (entget s)))) "LINE")
        (alert "Invalid object. Please select line object.")
    )
    (or
      (/= 4
          (logand
            4
            (cdr
              (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))
            )
          )
      )
      (alert
        (strcat "Select line object resides on a LOACKED layer <!>")
      )
    )
    (setq p (getpoint
              "\nSpecify a point to extend the previously line to : "
            )
    )
    (setq a (cdr (assoc 10 e))
          b (cdr (assoc 11 e))
          g (angle a b)
    )
    (vl-some '(lambda (u)
                (setq x (inters a b p (polar p (eval u) 1.0) nil))
              )
             '((+ g (* pi 0.5)) (+ g pi))
    )
    (setq d (if (< (distance x a) (distance x b))
              10
              11
            )
    )
    (entmod (subst (cons d x) (assoc d e) e))
  )
  (princ)
)

 

Thanks

Edited April 16, 2022 by prodromosm

[Guest]

any ideas?

 

Thanks

[lrm]

The following should work on multiple lines anywhere in 3D.

(defun c:test (/ p ss n i en ed e1 e2 ea eb end u d ee)
  ;; L. Minardi  5/2/2022
  (setq p (getpoint "\nSpecify projection point."))
  (setq ss (ssget '((0 . "line"))))
  (setq n (sslength ss))
  (setq i 0)
  (while (< i n)
    (setq en (ssname ss i))
    (setq ed (entget en))
    (setq e1 (cdr (assoc 10 ed))
	  e2 (cdr (assoc 11 ed))
    )
    (if	(> (distance e1 p) (distance e2 p))
      (progn
	(setq ea e1
	      eb e2
	      end 11
	)
      )
      (progn (Setq ea e2
		   eb e1
		   end 10
	     )
      )
    )
    (setq u (uvec ea eb))
    (setq d (dot (mapcar '- p ea) u))
    (setq ee (mapcar '+ ea (mapcar '* u (list d d d))))
    (entmod (subst (cons end ee) (assoc end ed) ed))
    (setq  i (+ i 1))
  )					; end while
  (princ)
)

; calculate unit vector from v1 to v2
(defun uvec (v1 v2 / s)
  (setq s (distance v1 v2))
  (setq s (mapcar '/ (mapcar '- v2 v1) (list s s s)))
)
;;; Compute the dot product of 2 vectors a and b
(defun dot (a b / dd)
  (setq dd (mapcar '* a b))
  (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
)					;end of dot

 

Edited May 2, 2022 by lrm

[Guest]

Hi lrm nice update but i find a problem with the trim. Trims the line from the side nearest to the point. Is  it possible to trim from the selected side  of the line?

 

Thanks

[lrm]

The program functions as you requested in your first post.  The following is how I interpret your revised request.  

Do you really want to trim the far end from the projected point if that is where the line is picked.  The red points are where the line was picked.  The whit points are the point to set the trimming.  The magenta line indicates the projected point onto the line.

 

Please edit the drawing/image to define what you want for these 4 cases.

 

 

 

 

 

trim lines.dwg

 

Edited May 4, 2022 by lrm

[Jozef13]

Hi,

my  expectations for those 4 cases are following

 

trim lines.dwg

[Guest]

Hi lrm. Look the example. Is not trim in correct direction. Trim. The extend is correct because the extend point is far away from the line, but  when I trim the line is more complicated 

Drawing1.dwg

[lrm]

It's still not clear what you want.  From your post

implies that  the line should be trimmed for the segment where the line is picked (selected).

 

Whereas (again from your post), the following implies the opposite.  That the pick point identifies the portion of the line to keep.

Which is it.  Keep or delete the segment with the pick point?

 

AutoCAD's trim command deletes the segment containing the pick point.  

 

 

[lrm]

This version trims the portion of the line where the line is picked for selection.  I

;  Trims selected line to the 3D projection of a point to the line.
; The line selection pick determines segment to be trimmed.
; L. Minardi  5/4/2022
(defun c:test (/ p ss en ed e1 e2 ea eb end u d ee)
  (setq p (getpoint "\nSpecify projection point."))
  (setq more T)
  (while more
    (setq ent (entsel))
    (if	ent
      (progn
	(setq pp (cadr ent)
	      en (car ent)
	      ed (entget en)
	      e1 (cdr (assoc 10 ed))
	      e2 (cdr (assoc 11 ed))
	)
	(if (> (distance e1 p) (distance e2 p))
	  (progn
	    (setq ea  e1
		  eb  e2
		  end 11
	    )
	  )
	  (progn (Setq ea  e2
		       eb  e1
		       end 10
		 )
	  )
	)
	(setq u	 (uvec ea eb)
	      d	 (dot (mapcar '- p ea) u)
	      ee (mapcar '+ ea (mapcar '* u (list d d d))) ; project point
	)
	; is ee in line segment      
	(if (< (* (dot (mapcar '- ee ea) (mapcar '- ee eb))) 0.0)
	;case for ee in line segment
	  (progn
	    (if
	      (> (* (dot (mapcar '- e1 ee) (mapcar '- pp ee))) 0.0)
	       (progn
		 (setq end 10)
		 (entmod (subst (cons end ee) (assoc end ed) ed))
	       )
	       (progn
		 (setq end 11)
		 (entmod (subst (cons end ee) (assoc end ed) ed))
	       )
	    )				
	  )				
	; case for ee beyond line segment      
	  (entmod (subst (cons end ee) (assoc end ed) ed))
	)	; end IF line segment check
      )
      (setq more nil)
    )					; end IF ent
  )					; end while
  (princ)
)
; calculate unit vector from v1 to v2
(defun uvec (v1 v2 / s)
  (setq s (distance v1 v2))
  (setq s (mapcar '/ (mapcar '- v2 v1) (list s s s)))
)
;;; Compute the dot product of 2 vectors a and b
(defun dot (a b / dd)
  (setq dd (mapcar '* a b))
  (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
)					;end of dot

 

[Guest]

The second code does exactly what I want. If it  gives me the opportunity (like the previous code) to select window, more than one lines will be perfect.