find dx and offset of a picked point relative to straight polyline

[motee]

Hello
any help to write a lisp that can print on screen dx and offset of a picked point relative to polyline as shown in attached image
thanks

[Tharwat]

Hi,

I am not sure that I got your point clearly so more details is required I guess.

Can you please write down the steps of the program that you are after?
eg: Select polyline, then Specify a point , .... etc

[motee]

Thank you tharwat for reply
step for input
1-pick the polyline
2-pick any place on screen to find dx and offset of this place relative to polyline
3-pick place to print dx and offset on screen

[Tharwat]

Can you please clarify what is the meaning of DX ? Is it a text, a point, ... ect ?
What to offset? the polyline or draw a polyline from that DX point perpendicular to the main polyline?

A drawing with before and after would help a lot to describe the issue.

[motee]

offset is the perpendicular distance between picked place and polyline
dx is the distance between start point of polyline and the fallen point of a picked point on the polyline
dx is the same delta x
soo offset and delta x is a number to be print on screen attached with a leader

[Tharwat]

Hi,

Something like this?

(defun c:Test ( / s p c a d)
  ;;	Tharwat - 28.May.2018		;;
  (if (and (setq s (car (entsel "\nPick a polyline :")))
         (or (= (cdr (assoc 0 (entget s))) "LWPOLYLINE")
             (alert "Invalid object! Please pick a polyline only.")
             )
         (setq p (getpoint "\nSpecify point perpendicular to polyline :"))
         (setq c (vlax-curve-getclosestpointto s p))
         (setq a (angle p c))
         (not (grdraw p c 1 -1)) ;; rubber line in red colour.
         (setq d (angle '(0. 0. 0.) (vlax-curve-getfirstderiv s (vlax-curve-getparamatpoint s c))))
         (or (or (equal (rem (+ d (* pi 0.5)) (+ pi pi)) a 1e-4)
                 (equal (rem (+ d (* pi 1.5)) (+ pi pi)) a 1e-4)
                 )
             (alert "Picked point is not a perpendicular to picked polyline. <!>")
             )
         )
  (command "_.leader" "_non" p "\\" "" (strcat "DX= " (rtos (vlax-curve-getdistatpoint s c) 2 4)
                                               "\\P"
                                               "Offset= " (rtos (distance c p) 2 4)) "")
  )
(princ)
) (vl-load-com)

[motee]

wow very nice lisp tharawat
one more thing i want if the picked point is outside the length of polyline
the dx distance will be minus value as shown on image
second need to add while if i have to repeat different point
thanks

[Tharwat]

Hi,

Please try this program and let me know.

(defun c:Test (/ *error* oblique ray_ b s p c a d m l z e r)
  ;;	Tharwat - 29.May.2018		;;
  (defun *error* (msg)
    (and r (vla-delete r))
    (princ "\n*cancel*")
  )
  ;;				;;
  (defun oblique (ent pnt)
    (angle '(0. 0. 0.)
           (vlax-curve-getfirstderiv
             ent
             (vlax-curve-getparamatpoint ent pnt)
           )
    )
  )
  ;;				;;
  (defun ray_ (spc pt1 pt2)
    (vlax-invoke spc 'addray pt1 pt2)
  )
  ;;				;;
  (setq b (vla-get-block
            (vla-get-activelayout
              (vla-get-activedocument (vlax-get-acad-object))
            )
          )
  )
  (cond
    ((=
       4
       (logand
         4
         (cdr
           (assoc 70
                  (setq e (entget (tblobjname "LAYER" (getvar 'clayer))))
           )
         )
       )
     )
     (alert "Current layer is locked <!>.")
    )
    ((minusp (cdr (assoc 62 e)))
     (alert "Current layer is off <!>.")
    )
    (t
     (while
       (and
         (setq s (car (entsel "\nPick a polyline :")))
         (or (= (cdr (assoc 0 (entget s))) "LWPOLYLINE")
             (alert "Invalid object! Please pick a polyline only.")
         )
         (setq
           p (getpoint "\nSpecify point perpendicular to polyline :")
         )
         (setq c (vlax-curve-getclosestpointto s p))
         (setq a (angle p c))
         (setq d (oblique s c))
         (or (or (equal (rem (+ d (* pi 0.5)) (+ pi pi)) a 1e-4)
                 (equal (rem (+ d (* pi 1.5)) (+ pi pi)) a 1e-4)
             )
             (progn
               (setq m (vl-sort (mapcar '(lambda (q) (cons (distance p q) q))
                                        (list (vlax-curve-getstartpoint s)
                                              (vlax-curve-getendpoint s)
                                        )
                                )
                                '(lambda (j k) (< (car j) (car k)))
                       )
                     z (cdr (car m))
                     r (ray_ b z (polar z (+ pi (oblique s z)) 1.0))
                     c (vlax-curve-getclosestpointto r p)
                     l (distance c z)
               )
               (vla-delete r)
               (if (zerop l)
                 (progn
                   (setq r (ray_ b z (polar z (oblique s z) 1.0))
                         c (vlax-curve-getclosestpointto r p)
                         l (distance c z)
                   )
                   (vla-delete r)
                 )
               )
               l
             )
         )
       )
        (command
          "_.leader"
          "_non"
          p
          "\\"
          ""
          (strcat
            (if l
              (strcat "DX= -" (rtos l 2 4))
              (strcat "DX= " (rtos (vlax-curve-getdistatpoint s c) 2 4))
            )
            "\\POffset= "
            (rtos (distance c p) 2 4)
          )
          ""
        )
     )
    )
  )
  (princ)
) (vl-load-com)

[motee]

thank you tharwat you are a great man
code is complete

[Tharwat]

thank you tharwat you are a great man
code is complete

Excellent. You are welcome anytime.

NOTE: I have updated he codes a bit that related to current layer for a better performance although the program may give unexpected result in certain cases if took a place.