Topic: How can I draw a line from a point perpendicular to a pline

[sub]

How can I draw a line from a point perpendicular to a nearest segment in polyline.

all in Lisp.

pseudocode
select the polyline by ENTSEL
select the point by GETPOINT
draw a line from point to line perpendicular to the polyline selected

Thanks in advance.

[Serge J. Gianolla]

Have a look here, I am pretty sure I spotted somethun' like it in the past! http://www.4d-technologies.com/techcenter/index.htm

[ronjonp]

Try this:

Code: [Select]

(Defun C:PERPL (/ SA SB SNP OM OS PT1 PT2)
;draws lines perpendicular from a starting point
  (setvar "cmdecho" 0)
  (setq
    SA (getvar "snapang")
    SB (getvar "snapbase")
    SNP (getvar "snapmode")
    OM (getvar "orthomode")
    OS (getvar "osmode")
    PT1 (osnap (getpoint
"\nPick point on line to draw perpendicular from: "
      )
      "nea"
)
  )
  (setvar "osmode" 0)
  (setq PT2 (osnap PT1 "end"))
  (if (equal PT1 PT2)
    (setq PT2 (osnap PT1 "MID"))
  )
  (command ".snap" "r" PT1 PT2)
  (setvar "snapmode" 0)
  (setvar "orthomode" 1)
  (prompt "\nto point:")
  (command ".pline" PT1 pause "")
  (setvar "snapang" SA)
  (setvar "snapbase" SB)
  (setvar "snapmode" SNP)
  (setvar "orthomode" OM)
  (setvar "osmode" OS)
  (setvar "cmdecho" 1)
  (princ)
) ; end perpl.lsp
(c:perpl)

[CAB]

Serge, could not find it over there but got some good routines.
Here is one I put together from some borrowed subroutines.

Code: [Select]

;;; =====================================================
;;;    c:pl_perp2segment.lsp  By CAB 07/21/04            
;;;
;;;    Draw a line perpendicular to a polyline segment
;;;    picked by the user from a point picked
;;;    Will draw to extension of segment if point is not
;;;    perpendicular to segment
;;;
;;;    Uses current layer
;;;
;;;    Also works with Arc, Circle & Line but the segment
;;;    created is to the chord in Arcs & Circles
;;; =====================================================
(defun c:pl_perp2segment ()
  (if (and (setq ent (entsel "Pick a polyline: "))
           (member (cdr (assoc 0 (entget (car ent))))
                   '("LWPOLYLINE" "ARC" "CIRCLE" "LINE"))
           )
    (if (setq pt (getpoint "\nSelect point."))
      (progn
         (setq plst (getsegment
                      (vlax-ename->vla-object (car ent))
                      (cadr ent)
                    )
         )
         (setq ppl (ge_perppt pt (cadr plst) (caddr plst)))
         (command "._line" "non" ppl "non" pt "")
        )
      (prompt "\n *-* User quit *-*")
      );endif
      (prompt "\n *-* Invalid object selected *-*")
  ); endif
  (princ)
); defun

(defun getsegment (obj pt / cpt eparam stparam)
  (cond
    ((setq cpt (vlax-curve-getclosestpointto obj pt t))
     (setq eparam (fix (vlax-curve-getendparam obj)))
     (if (= eparam (setq stparam (fix (vlax-curve-getparamatpoint obj cpt))))
       (setq stparam (1- stparam))
       (setq eparam (1+ stparam))
     )
     (list eparam
           (vlax-curve-getpointatparam obj stparam)
           (vlax-curve-getpointatparam obj eparam)
     )
    )
  )
)

;; ! ****************************************************************************
;; ! GE_PerpPt
;; ! ****************************************************************************
;; ! Function : Locate the perpendicular drop point from a point pp to any line
;; !            segment defined by two other points pt1 and pt2
;; ! Argument : [pp] - Point to drop from
;; !            [p1] - First Point of line segment
;; !            [p2] - Second Point of line segment
;; ! Return   : The drop point on the line segment
;; ! (C) 1999-2004, Four Dimension Technologies, Bangalore
;; ! e-mail   : rakesh.rao@4d-technologies.com
;; ! Web      : www.4d-technologies.com
;; ! ****************************************************************************
(defun ge_perppt (pp p1 p2 / x y x1 x2 x3 x4 y1 y2 y3 y4 m p4)
  (setq
    x  (car pp)
    y  (cadr pp)
    x1 (car p1)
    y1 (cadr p1)
    x2 (car p2)
    y2 (cadr p2)
  )

  (cond
    ((equal x1 x2 0.0000001) ; Vertical line
     (setq
       x4 x1
       y4 y
       p4 (list x4 y4 0.0)
     )
    )
    ((equal y1 y2 0.0000001) ; Horizontal line
     (setq
       x4 x
       y4 y1
       p4 (list x4 y4 0.0)
     )
    )
    (t
     (setq
       m  (/ (- y2 y1) (- x2 x1)) ; gradient p1- p2
       x4 (/ (+ (/ x m) (+ y (- (* m x1) y1))) (+ (/ 1 m) m))
       y4 (+ y1 (* m (- x4 x1)))
       p4 (list x4 y4 0.0)
     )
    )
  )
  p4
)
(defun c:Perp()
  (c:pl_perp2segment)
)
(prompt "\n*-*  pl_perp2segment loaded, Enter Perp to run." )
(princ)

[CAB]

Also check this thread out
http://theswamp.org/phpBB2/viewtopic.php?t=1468&start=30
It doesn't limit the perpindicular line to the segment picked though.
But very cool routine.