Extend line perpendicular to point

February 10, 2021

Dear all,

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

February 10, 2021

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

February 10, 2021

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

February 11, 2021

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

Easy-peasy!

February 11, 2021

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!

February 11, 2021

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

April 16, 2022

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

May 1, 2022

any ideas?

Thanks

Website · May 2, 2022

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

May 3, 2022

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

Website · May 4, 2022

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

May 4, 2022

Hi,

my expectations for those 4 cases are following

trim lines.dwg

May 4, 2022

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

Website · May 4, 2022

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.

Website · May 4, 2022

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

May 4, 2022

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.

Sign In

Extend line perpendicular to point

Recommended Posts

Jozef13

Tharwat

Jozef13

tombu

JerryFiedler

Jozef13

Guest

Guest

lrm

Guest

lrm

Jozef13

Guest

lrm

lrm

Guest

Join the conversation

Tutorials

Forums

Activity