Nearest point to a line from a point

October 20, 2015

I need to find out the coordinates of the nearest point on a selected line from a picked point by lisp.

Please help me.

October 20, 2015

You want to find a point OBJECT that is the nearest to a picked point from a user ?

October 20, 2015

You want to find a point OBJECT that is the nearest to a picked point from a user ?

Yes . and the line is a straight line.

October 20, 2015

Yes . and the line is a straight line.

This?

(defun c:test (/ ss p e d s n)
 ;; Tharwat 20.10.2015    ;;
 (cond
   ((not (setq ss
                (ssget "_X" (list '(0 . "POINT") (cons 410 (getvar 'ctab))))
         )
    )
    (alert "Couldn't find any Point object in this space !")
   )
   ((setq p (getpoint "\nSpecify a point :"))
    ((lambda (r)
       (while (setq e (ssname ss (setq r (1+ r))))
         (if (not d)
           (setq d (distance p (cdr (assoc 10 (entget e))))
                 s e
           )
           (if
             (< (setq n (distance p (cdr (assoc 10 (entget e))))) d)
              (setq d n
                    s e
              )
           )
         )
       )
     )
      -1
    )
    (grdraw p (cdr (assoc 10 (entget s))) 3 -1)
    (sssetfirst nil (ssadd s))
   )
 )

 (princ)
)

October 20, 2015

Thanks Mr Tharwat your code is working properly.

But I think you may have confused my poor English.

Actually I need the perpendicular location on the selected line from a picked point.

I mean I will pick a point on the screen and next select the line.

Then I need to draw a perpendicular line from point to line.

Sorry for the disturbing you.

October 20, 2015

Use vlax-curve-getclosestpointto or this function.

October 20, 2015

Maybe:

[b][color=BLACK]([/color][/b]defun c:perpt [b][color=FUCHSIA]([/color][/b]/ ss en ed p1 p2 p pp[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]not en[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]setq ss [b][color=GREEN]([/color][/b]ssget '[b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]0 . [color=#2f4f4f]"LINE"[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]= [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b] 1[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss 0[b][color=GREEN])[/color][/b]
                   ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   p1 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 10 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   p2 [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 11 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq p [b][color=MAROON]([/color][/b]getpoint [color=#2f4f4f]"\nSelect Point:   "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]setq pp [b][color=BLUE]([/color][/b]inters [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]car p[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cadr p[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                                [b][color=RED]([/color][/b]polar p [b][color=PURPLE]([/color][/b]+ [b][color=TEAL]([/color][/b]angle p1 p2[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]* pi 0.5[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] 1[b][color=RED])[/color][/b]
                                p1 p2 nil[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]grdraw p pp 2 3[b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]princ [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"\nPerpendicular point - "[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]prin1 [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]car pp[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cadr pp[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]T
              [b][color=GREEN]([/color][/b]princ [color=#2f4f4f]"\n Perpendicular point PP cannot be calulated"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

October 20, 2015

(defun test(/ ss d lst i)
 
(if(setq p (car(cdr(entsel "select a line"))))
 (progn
(setq ss (ssget "_X" '((0 . "POINT"))))
(while ss
	(setq d (cdr(assoc 10 (entget (ssname ss 0)))))
	(setq lst (cons (distance d p) lst))
  (ssdel  (ssname ss 0) ss)
  
)
(setq lst (vl-sort lst '>))
(sssetfirst nil (car lst))
       )
   )


)

; error: Exception occurred: 0xC0000005 (Access Violation)

; warning: unwind skipped on exception

; error: Exception occurred: 0xC0000005 (Access Violation)

_$

any idea why?

October 20, 2015

This?

(defun c:test (/ ss p e d s n)
 ;; Tharwat 20.10.2015    ;;
 (cond
   ((not (setq ss
                (ssget "_X" (list '(0 . "POINT") (cons 410 (getvar 'ctab))))
         )
    )
    (alert "Couldn't find any Point object in this space !")
   )
   ((setq p (getpoint "\nSpecify a point :"))
    ((lambda (r)
       (while (setq e (ssname ss (setq r (1+ r))))
         (if (not d)
           (setq d (distance p (cdr (assoc 10 (entget e))))
                 s e
           )
           (if
             (< (setq n (distance p (cdr (assoc 10 (entget e))))) d)
              (setq d n
                    s e
              )
           )
         )
       )
     )
      -1
    )
    (grdraw p (cdr (assoc 10 (entget s))) 3 -1)
    (sssetfirst nil (ssadd s))
   )
 )

 (princ)
)

isnt that calling (assoc 10 (entget e) each time is a wast?

October 20, 2015

If you wanted to go the vector route:

;; Project Point onto Line  -  Lee Mac
;; Projects pt onto the line defined by p1,p2

(defun LM:projectpointtoline ( pt p1 p2 / v1 )
   (if (setq v1 (vx1 (mapcar '- p2 p1)))
       (mapcar '+ p1 (vxs v1 (vxv (mapcar '- pt p1) v1)))
   )
)

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
   (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Dot Product  -  Lee Mac
;; Args: u,v - vectors in R^n

(defun vxv ( u v )
   (apply '+ (mapcar '* u v))
)

;; Unit Vector  -  Lee Mac
;; Args: v - vector in R^2 or R^3

(defun vx1 ( v )
   (   (lambda ( n ) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
       (distance '(0.0 0.0 0.0) v)
   )
)

Test program:

(defun c:test ( / e p q )
   (if (and (setq e (car (entsel "\nSelect line: ")))
            (= "LINE" (cdr (assoc 0 (setq e (entget e)))))
            (setq p (getpoint "\nSpecify point: "))
       )
       (if (setq q (LM:projectpointtoline (trans p 1 0) (cdr (assoc 10 e)) (cdr (assoc 11 e))))
           (entmake (list '(0 . "POINT") (cons 10 q)))
           (princ "\nZero length line.")
       )
   )
   (princ)
)

October 20, 2015

If you wanted to go the vector route:

;; Project Point onto Line  -  Lee Mac
;; Projects pt onto the line defined by p1,p2

(defun LM:projectpointtoline ( pt p1 p2 / v1 )
   (if (setq v1 (vx1 (mapcar '- p2 p1)))
       (mapcar '+ p1 (vxs v1 (vxv (mapcar '- pt p1) v1)))
   )
)

;; Vector x Scalar  -  Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
   (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Dot Product  -  Lee Mac
;; Args: u,v - vectors in R^n

(defun vxv ( u v )
   (apply '+ (mapcar '* u v))
)

;; Unit Vector  -  Lee Mac
;; Args: v - vector in R^2 or R^3

(defun vx1 ( v )
   (   (lambda ( n ) (if (equal 0.0 n 1e-10) nil (mapcar '/ v (list n n n))))
       (distance '(0.0 0.0 0.0) v)
   )
)

Test program:

(defun c:test ( / e p q )
   (if (and (setq e (car (entsel "\nSelect line: ")))
            (= "LINE" (cdr (assoc 0 (setq e (entget e)))))
            (setq p (getpoint "\nSpecify point: "))
       )
       (if (setq q (LM:projectpointtoline (trans p 1 0) (cdr (assoc 10 e)) (cdr (assoc 11 e))))
           (entmake (list '(0 . "POINT") (cons 10 q)))
           (princ "\nZero length line.")
       )
   )
   (princ)
)

Thanx Lee

but cant see why i get an error in my test?

October 20, 2015

(defun test(/ ss d lst i)
 
(if(setq p (car(cdr(entsel "select a line"))))
 (progn
(setq ss (ssget "_X" '((0 . "POINT"))))
(while ss
	(setq d (cdr(assoc 10 (entget (ssname ss 0)))))
	(setq lst (cons (distance d p) lst))
  (ssdel  (ssname ss 0) ss)
  
)
(setq lst (vl-sort lst '>))
(sssetfirst nil (car lst))
       )
   )


)
; error: Exception occurred: 0xC0000005 (Access Violation)

; warning: unwind skipped on exception

; error: Exception occurred: 0xC0000005 (Access Violation)

; error: Exception occurred: 0xC0000005 (Access Violation)

; error: Exception occurred: 0xC0000005 (Access Violation)

; error: Exception occurred: 0xC0000005 (Access Violation)

; error: Exception occurred: 0xC0000005 (Access Violation)

_$

_$

any idea why?

Two immediate problems:

1) The selection set variable 'ss' will not be null when all items are removed, so the code will eventually attempt to access an entity from an empty selection set & delete an entity from an empty selection set.

2) (sssetfirst nil (car lst)): the sssetfirst function requires a selection set argument, not a numerical value.

October 20, 2015

Thanx Lee
but cant see why i get an error in my test?

My code was in response to the OP, not to your question.

October 20, 2015

Thanks everybody.

October 20, 2015

My code was in response to the OP, not to your question.

dont love me anymore?

October 20, 2015

Excuse me?

October 20, 2015

Sorry Lee...

October 20, 2015

This?

(defun c:test (/ ss p e d s n)
 ;; Tharwat 20.10.2015    ;;
 (cond
   ((not (setq ss
                (ssget "_X" (list '(0 . "POINT") (cons 410 (getvar 'ctab))))
         )
    )
    (alert "Couldn't find any Point object in this space !")
   )
   ((setq p (getpoint "\nSpecify a point :"))
    ((lambda (r)
       (while (setq e (ssname ss (setq r (1+ r))))
         (if (not d)
           (setq d (distance p (cdr (assoc 10 (entget e))))
                 s e
           )
           (if
             (< (setq n (distance p (cdr (assoc 10 (entget e))))) d)
              (setq d n
                    s e
              )
           )
         )
       )
     )
      -1
    )
    (grdraw p (cdr (assoc 10 (entget s))) 3 -1)
    (sssetfirst nil (ssadd s))
   )
 )

 (princ)
)

can you explain what going on here after getpoint? how r get its value?

October 20, 2015

alanjt posted one for me at http://forums.augi.com/showthread.php?149591-Perpendicular-2D-snap-to-line&p=1228990&viewfull=1#post1228990

It's been in my Object Snap Cursor Menu ever since. Works great!

; 2D Perpendicular osnap.
; http://forums.augi.com/showthread.php?149591-Perpendicular-2D-snap-to-line&p=1228966#post1228966#16
; alanjt
;Macro ^P(or PPP (load "PPP.lsp"))(PPP);
(defun PPP (/ ent pnt)
 (if (eq (logand 1 (getvar 'cmdactive)) 1)
   (progn
     (while (progn (setvar 'ERRNO 0)
                   (setq ent (car (entsel "\nSelect curve: ")))
                   (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                         ((eq (type ent) 'ENAME)
                          (if (vl-catch-all-error-p
                                (vl-catch-all-apply 'vlax-curve-getEndParam (list ent))
                              )
                            (princ "\nInvalid object!")
                          )
                         )
                   )
            )
     )
     (if (and ent
              (setq pnt (vlax-curve-getClosestPointToProjection
                          ent
                          (trans (getvar 'LASTPOINT) 1 0)
                          '(0 0 1)
                        )
              )
         )
       (command "_non" (trans pnt ent 1))
     )
   )
   (alert "** Command must be executed transparently! **")
 )
 (princ)
)

October 26, 2015

This?

(defun c:test (/ ss p e d s n)
 ;; Tharwat 20.10.2015    ;;
 (cond
   ((not (setq ss
                (ssget "_X" (list '(0 . "POINT") (cons 410 (getvar 'ctab))))
         )
    )
    (alert "Couldn't find any Point object in this space !")
   )
   ((setq p (getpoint "\nSpecify a point :"))
    ((lambda (r)
       (while (setq e (ssname ss (setq r (1+ r))))
         (if (not d)
           (setq d (distance p (cdr (assoc 10 (entget e))))
                 s e
           )
           (if
             (< (setq n (distance p (cdr (assoc 10 (entget e))))) d)
              (setq d n
                    s e
              )
           )
         )
       )
     )
      -1
    )
    (grdraw p (cdr (assoc 10 (entget s))) 3 -1)
    (sssetfirst nil (ssadd s))
   )
 )

 (princ)
)

hi Mr

how and why (lambda) get its value?

Nearest point to a line from a point

Recommended Posts

wimal

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

samifox

Tharwat

Link to comment

Share on other sites

wimal

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

wimal

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

David Bethel

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

wimal

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

Lee Mac

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

tombu

Link to comment

Share on other sites

samifox

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity