TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: DEVITG on June 01, 2004, 05:02:49 PM

Title: line from a point perpendicular to a line
Post by: DEVITG on June 01, 2004, 05:02:49 PM
I had seen this topic before , but I can not find it.


How can I draw a line from a point perpendicular to a line .

all in Lisp.

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

Thanks in advance.
Title: line from a point perpendicular to a line
Post by: ronjonp on June 01, 2004, 06:36:45 PM
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)
Title: line from a point perpendicular to a line
Post by: DEVITG on June 01, 2004, 07:35:04 PM
Hi Ronjop, it is not what I need

In the drawing  I pick for the line , and then pick the point
after it I need to draw , no more mouse movement , a line FROM the point to the line in perperndicular
Like I draw from a point to a OSNAP PER to line.

But no pointer movement
 :oops:
Title: line from a point perpendicular to a line
Post by: Jeff_M on June 01, 2004, 08:26:06 PM
Devitg,

Here's one that does this.
Code: [Select]

(defun c:prp2ln (/ ANG INTPT LINE PT1 PT2 PT3 PT4)
  (setq old-os (getvar "osmode"))
  (setvar "osmode" 0)
  (and (setq line (entsel "\nSelect line: "))
       (setq line (entget (car line)))
       (setq pt1 (cdr (assoc 10 line))
    pt2 (cdr (assoc 11 line))
    )
       (setq pt3 (getpoint "\nSelect point to draw perpendicular from: "))
       (setq ang (angle pt1 pt2))
       (setq pt4 (polar pt3 (+ ang (/ pi 2)) 1))
       (setq intPt (inters pt1 pt2 pt3 pt4 nil))
       (command "line" pt3 intPt "")
       )
  (setvar "osmode" old-os)
  (princ)
  )


Jeff
Title: line from a point perpendicular to a line
Post by: SpeedCAD on June 01, 2004, 10:45:12 PM
This too:

Code: [Select]
(defun c:perLinea
       (/ vla-linea punto p1 p2 angulo pPer dist seleccion *osmode)
  (setq *osmode (getvar "osmode"))
  (setq vla-linea (vlax-ename->vla-object
   (car (entsel "\nSelecione línea: "))
 )
punto  (getpoint "\nSelecione punto para perpendicularidad: ")
p1  (vlax-safearray->list
   (vlax-variant-value
     (vla-get-startpoint vla-linea)
   )
 )
p2  (vlax-safearray->list
   (vlax-variant-value
     (vla-get-endpoint vla-linea)
   )
 )
angulo  (angle p1 p2)
pPer  (inters
   p1
   p2
   punto
   (polar punto (+ angulo (/ pi 2)) 1)
   nil
 )
dist  (distance punto Pper)
  )
  (vla-addline
    (vla-objectidtoobject
      (vla-get-document vla-linea)
      (vla-get-ownerid vla-linea)
    )
    (vlax-3d-point punto)
    (vlax-3d-point pPer)
  )
  (setvar "osmode" 512)
  (while (and (setq seleccion (getpoint "\nSeleccione linea: "))
     (equal (ssname (ssget seleccion) 0)
    (vlax-vla-object->ename vla-linea)
     )
)
    (vla-addline
      (vla-objectidtoobject
(vla-get-document vla-linea)
(vla-get-ownerid vla-linea)
      )
      (vlax-3d-point seleccion)
      (vlax-3d-point
(polar seleccion (+ (angle punto pPer) pi) dist)
      )
    )
  ) ;_while
  (setvar "osmode" *osmode)
) ;_defun
Title: line from a point perpendicular to a line
Post by: Keith™ on June 02, 2004, 12:03:28 AM
Interesting Jeff... that is just about how I would have done it...
Title: line from a point perpendicular to a line
Post by: Jeff_M on June 02, 2004, 12:07:59 PM
Actually, Keith, after I posted that I decided that it would be best to entmake the line, removing the need to store, change, reset the osnaps. So here's my revised code:
Code: [Select]

(defun c:perp2ln (/ ANG INTPT LINE PT1 PT2 PT3 PT4)
  (and (setq line (entsel "\nSelect line: "))
       (setq line (entget (car line)))
       (setq pt1 (cdr (assoc 10 line))
    pt2 (cdr (assoc 11 line))
    )
       (setq pt3 (getpoint "\nSelect point to draw perpendicular from: "))
       (setq ang (angle pt1 pt2))
       (setq pt4 (polar pt3 (+ ang (/ pi 2)) 1))
       (setq intPt (inters pt1 pt2 pt3 pt4 nil))
       (entmake (list '(0 . "LINE")
     (cons 10 pt3)
     (cons 11 intPt)
     )
)
       )
  (princ)
  )

Jeff
Title: line from a point perpendicular to a line
Post by: DEVITG on June 02, 2004, 12:49:26 PM
Thanks  all you for your help .

 :D  :)  :lol:  :o  :wink:  :idea:  :!:
Title: line from a point perpendicular to a line
Post by: DEVITG on June 02, 2004, 02:29:33 PM
I made this change to draw multiple perpendicular lines to a selected line

Code: [Select]

;;my OS and #oldos FUNcTIONS

(DEFUN OS (VAL)  ; A FUNCTION TO CHANGE OSMODE  BY "VAL" AS FOLLOW
(setq oldos   (getvar "osmode"))
;;;0  NONe
;;;1  ENDpoint
;;;2  MIDpoint
;;;4  CENter
;;;8  NODe
;;;16  QUAdrant
;;;32  INTersection
;;;64  INSertion
;;;128  PERpendicular
;;;256  TANgent
;;;512  NEArest
;;;1024  QUIck
;;;2048  APParent Intersection
;;;4096    EXTension
;;;8192    PARallel
  ;; IF VAL = 1+2+4 = 7 IT WIL DO END MID AND CENT

  (SETVAR "OSMODE" VAL)
) ;_ END OS FUNCTION

(defun #oldos ( )
  (setvar "osmode" oldos)
  )
;;**********************************************************

(defun c:prp2ln (/ ANG INTPT LINE PT1 PT2 PT3 PT4)
  (setq old-os (getvar "osmode"))
  (setvar "osmode" 0)
  (and (setq line (entsel "\nSelect line: "))
       (setq line (entget (car line)))
       (setq pt1 (cdr (assoc 10 line))
        pt2 (cdr (assoc 11 line))
        )
       (os 8)
       
  (WHILE
(OS 8)
    (setq pt3 (getpoint "\nSelect point to draw perpendicular from: "))
       (setq ang (angle pt1 pt2))
       (setq pt4 (polar pt3 (+ ang (/ pi 2)) 1))
       (setq intPt (inters pt1 pt2 pt3 pt4 nil))
(os 0)
       (command "line" pt3 intPt "")
       ))
 
  (setvar "osmode" old-os)
  (princ)
  )
(c:prp2ln)


Add the while to select points until need , and the osmode 8 to osnap on node.
Title: line from a point perpendicular to a line
Post by: CAB on June 06, 2004, 06:36:33 PM
I created a similar routine about 6 months ago, but Jeff's
code is much better so I adopted his code for my routine.
I use it to create elevations, drawing lines from points on the
plan view to a base line. I rotate the ucs to each elevation so
i needed to include a correction for that condition.

 DEVITG
 My routine repeats as yours does. Although if you use the ENTMAKE
 you will not need to switch OSMODE on and off.
 
 Here it is.

Code: [Select]
(defun c:LnRay (/ ang intpt ent p1 p2 p3 p4)
  (if (setq ent (entsel "\nSelect base line: "))
    (if (= "LINE" (cdr (assoc 0 (setq ent (entget (car ent))))))
      (progn
        (setq p1  (cdr (assoc 10 ent))
              p2  (cdr (assoc 11 ent))
              ang (angle p1 p2)
        )
        (while
          (setq p3
                 (getpoint
                   "\nSelect point to draw perpendicular from, Enter to quit: "
                 )
          )
           (setq p3 (trans p3 1 0)) ; adjust for non-World UCS
           (setq p4 (polar p3 (+ ang (/ pi 2)) 100))
           (setq intpt (inters p1 p2 p3 p4 nil))
           (entmake (list '(0 . "LINE")
                          (cons 10 p3)
                          (cons 11 intpt)
                    )
           )
        ) ; end while
      ) ; progn
      (prompt "\nObject is not a LINE.")
    ) ; endif
    (prompt "\nNothing Selected.")
  ) ; endif
  (princ)
)

(prompt "\nElev Lines loaded, type LnRay to run")
(princ)
Title: perp line from a point to a line
Post by: DEVITG on June 06, 2004, 07:46:57 PM
Hi Cab , would you please , explain the pourpouse of using
Quote
(setq p3 (trans p3 1 0)) ; adjust for non-World UCS

 :oops:
Title: line from a point perpendicular to a line
Post by: CAB on June 06, 2004, 08:01:57 PM
Well I'll try. :)

I use this
Code: [Select]
^C^Cdview;;tw;-90;;_ucs;w;_ucs;z;90;
to rotate the house plan view so that the right side is at the bottom of the
screen. I then draw the right elevation.
The TRANS function returns the correct coordinates for that UCS. It only comes
into play when then UCS is not World. If you don't rotate the ucs you do not need it.

Here (http://theswamp.org/phpBB2/viewtopic.php?t=592&highlight=trans) is the thread with more info.
Title: line from a point perpendicular to a line
Post by: SMadsen on June 07, 2004, 09:30:27 AM
Here's a more mathematical approach, using a dot product to find the perp point. It has the advantage of working in 3D (which INTERS is a bit picky about).

The parameter r can be used for various information (it's the distance ratio where the perpendicular hits the line).

Code: [Select]
(defun C:P2LINE (/ dist ent entl p1 p2 p3 np up r)
  (and (setq ent (car (entsel "Select line: ")))
       (setq entl (entget ent))
       (= (cdr (assoc 0 entl)) "LINE")
       (setq p1   (trans (cdr (assoc 10 entl)) 0 1)
             p2   (trans (cdr (assoc 11 entl)) 0 1)
             dist (distance p1 p2)
       )
       (while (setq p3 (getpoint "\nPick a point: "))
         (setq r  (/ (apply '+ (mapcar (function (lambda (a b c)
                        (* (- c a) (- b a)))) p1 p2 p3))
                     (expt dist 2.0)
                  )
               np (mapcar (function (lambda (a b) (+ a (* r (- b a))))) p1 p2)
               up (trans np 1 0)
         )
         (entmake (list '(0 . "LINE") (cons 10 (trans p3 1 0))(cons 11 up)))
         (mapcar 'princ (list "\nDistance from point to perp of line: "
                        (rtos (distance p3 np) 2)
                              "\nPerpendicular point on line (WCS): "
                              "\nX = " (car up) "\tY = " (cadr up)
                              "\tZ = " (caddr up)))
         (and (= (getvar "WORLDUCS") 0)
              (mapcar 'princ (list  "\nIn current UCS:\nX = "
                          (car np) "\tY = " (cadr np) "\tZ = " (caddr np))))
       )
  )
  (princ)
)
Title: line from a point perpendicular to a line
Post by: Mark on June 07, 2004, 09:56:55 AM
that's a thing of beauty Stig.
Title: line from a point perpendicular to a line
Post by: SMadsen on June 07, 2004, 10:12:05 AM
You mean it works? Excellent!  :)
Title: line from a point perpendicular to a line
Post by: Mark on June 07, 2004, 10:18:06 AM
No I meant the code. <g>
Title: line from a point perpendicular to a line
Post by: CAB on June 07, 2004, 10:18:51 AM
Stig,
Good point about the 3D aspect, In my old routine I converted to 2D points
but forgot to here. Here is my revised version.
I my testing points p1 & p2 did not need to be transed, not understanding the
entire process I am not sure why. The results were correct so I did not
trans p1 & p2 but I see you did.
Ugh, your math went by me like an express train with no stop here. WTFWT :shock:

CAB


Code: [Select]
;;  this prg draws a vertical line from a picked point
;;    to a picked base line
 
(defun c:LnRay (/ ang intpt ent p1 p2 p3 p4)
  ;;Make 2D point from 3D point
  (defun 3dP->2dP (3dpt)(list (car 3dpt) (cadr 3dpt)))
  (if (setq ent (entsel "\nSelect base line: "))
    (if (= "LINE" (cdr (assoc 0 (setq ent (entget (car ent))))))
      (progn
        (setq p1  (3dP->2dP(cdr (assoc 10 ent)))
              p2  (3dP->2dP(cdr (assoc 11 ent)))
              ang (angle p1 p2)
        )
        (while
          (setq p3
                 (getpoint
                   "\nSelect point to draw perpendicular from, Enter to quit: "
                 )
          )
           (setq p3 (3dP->2dP(trans p3 1 0))) ; adjust for non-World UCS
           (setq p4 (polar p3 (+ ang (/ pi 2)) 100))
           (setq intpt (inters p1 p2 p3 p4 nil))
           (entmake (list '(0 . "LINE")
                          (cons 10 p3)
                          (cons 11 intpt)
                    )
           )
        ) ; end while
      ) ; progn
      (prompt "\nObject is not a LINE.")
    ) ; endif
    (prompt "\nNothing Selected.")
  ) ; endif
  (princ)
)

(prompt "\nElev Lines loaded, type LnRay to run")
(princ)
Title: line from a point perpendicular to a line
Post by: SMadsen on June 07, 2004, 10:52:18 AM
Heh Mark  :D

CAB, you don't need to convert the line's points to UCS because you're converting p3 to WCS where p1 and p2 is also located. I did it the other way 'round .. a bit more work but indifferent to the result.

The math behind it is explained here (http://www.astronomy.swin.edu.au/~pbourke/geometry/pointline/) if you're interested. Not very complicated.
Title: line from a point perpendicular to a line
Post by: CAB on June 07, 2004, 11:17:51 AM
Quote from: Stig
CAB, you don't need to convert the line's points to UCS because you're converting
p3 to WCS where p1 and p2 is also located. I did it the other way 'round .. a bit more work but
indifferent to the result.

Thanks for the explanation.


Another nice Link (http://www.astronomy.swin.edu.au/~pbourke/geometry/), thanks.

Quote from: Stig
Not very complicated.

Easy for you to say, I couldn't fix my rubix cube either. :)
Title: line from a point perpendicular to a line
Post by: DEVITG on June 08, 2004, 07:47:37 AM
Hi Stig , it is a good way to learn about lambda and mapcar,
I shall do !!
I will dig on it, to learn about it.

Thanks for it.

 :)
Title: line from a point perpendicular to a line
Post by: SMadsen on June 08, 2004, 08:30:26 AM
My pleasure, DEVITG

I guess it's not a bad example for practicing ones MAPCAR skills.

Take for instance the dot product of two vectors: P1 dot P2. It can be written out as (+ (* x1 x2)(* y1 y2)(* z1 z2)), or without having to assign six different variables:
(+ (* (car p1)(car p2))(* (cadr p1)(cadr p2))(* (caddr p1)(caddr p2)))

That's quite a lot to write. Cos' multiplications happen on same level in two point lists, it can more easily be written as (mapcar '* p1 p2). To add all values in the list of products, simply apply an addition:

(apply '+ (mapcar '* p1 p2))

And so, a dot product function was born.

Of course, in the point-to-perpendicular case we needed to substract vectors before multiplying the coordinates. Written in its entirety it would look something like this:

(+ (* (- (car p3) (car p1))(- (car p2) (car p1))) (* (- (cadr p3) (cadr p1))(- (cadr p2) (cadr p1))) (* (- (caddr p3) (caddr p1)) (- (caddr p2) (caddr p1))))

Like with the simple multiplication above, the exact same things happen on each level. Only thing changing is the operator, which means that '(* p1 p2) should be replaced with '(* (- p3 p1)(- p2 p1)).
If one takes to subtract vectors before multiplying them, it could be written with multiple MAPCAR's:

(apply '+ (mapcar '* (mapcar '- p3 p1)(mapcar '- p2 p1)))


Or it could be stuffed into a LAMBDA function, doing it all in one go:

(apply '+ (mapcar '(lambda (a b c)(* (- c a) (- b a))) p1 p2 p3))
Title: line from a point perpendicular to a line
Post by: JohnK on June 08, 2004, 09:28:46 AM
Say, i have this theory that Mapcar is a recursive function and foreach is actualy the itterative version of mapcar. In fact in an attempt to "prove it" i spent some time rebuilding the "Map" function. *But anyways.... Im babbling now*

Does anyone know if Mapcar is a recrusive function?
Title: line from a point perpendicular to a line
Post by: SMadsen on June 08, 2004, 10:43:13 AM
Here's a take on writing your own MAPCAR function. As you can see it is recursive:

Code: [Select]
(defun mapIt (fn lst)
  (cond ((null lst) nil)
        (T (cons (eval (list fn (car lst))) (mapIt fn (cdr lst))))
  )
)


(mapit '(lambda (n)(+ n 5)) '(1 2 3))
(6 7 8 )

(mapit (function (lambda (n)(cons n (chr n)))) '(65 66 97))
((65 . "A") (66 . "B") (97 . "a"))

(mapit 'chr '(65 66 97))
("A" "B" "a")

Most of the functions that we take for granted are recursive .. MEMBER, APPEND, ASSOC, SUBST etc. etc.

For example, here's a simple rebuild of ASSOC:

Code: [Select]
(defun associate (item lst)
  (cond ((equal (caar lst) item) (car lst))
        (T (associate item (cdr lst)))
  )
)


(setq alist '((0 . "A")(1 . "B")(2 . "C")(3 . "D")))

(associate 2 alist)
(2 . "C")
Title: line from a point perpendicular to a line
Post by: SMadsen on June 08, 2004, 10:46:52 AM
Quote from: Se7en
In fact in an attempt to "prove it" i spent some time rebuilding the "Map" function.

How much time was it?? :)
Title: line from a point perpendicular to a line
Post by: JohnK on June 08, 2004, 10:54:00 AM
Outstanding! Stig you are amazing!

Oh not much. I didnt get very far at all, but i did find this. (I dont know it even works or not ...dosent look like it would. :P)
Code: [Select]
(defun MapItter (pros lst / cntr nlst lstlength)
  (setq cntr 0 lstlength (length lst))
  (while (< cntr lstlength)
    (setq nlst (cons (pros (nth cntr lst)) nlst))
     (setq cntr (1+ cntr)))
  (reverse nlst)
  )


thanx Stig.
Title: line from a point perpendicular to a line
Post by: SMadsen on June 08, 2004, 11:03:28 AM
Mind if I rename it to MapItcher? :)

Well, it works for non-quoted predefined function names - so you can't pass lambda expressions to it.

I would write it with an evaluater, e.g.
(setq nlst (cons (eval (list pros (nth cntr lst))) nlst))

, or

(setq nlst (cons (apply pros (list (nth cntr lst))) nlst))
Title: line from a point perpendicular to a line
Post by: CAB on June 08, 2004, 11:06:20 AM
Just an observation.
Most of us think in English or our native language about lisp
but it appears to me that Stig has internalized lisp and now
"Thinks in LISP" :)
Title: line from a point perpendicular to a line
Post by: SMadsen on June 08, 2004, 11:12:43 AM
Beware of the Knights who say "Nil!"
Title: line from a point perpendicular to a line
Post by: JohnK on June 08, 2004, 11:32:11 AM
Code: [Select]
(defun Convo2SMadsen ()
  (setq res (how are you?))
  (cond
    ((eq  (eval res) 'T)
     "Good, I'm glad to hear that")
    ((eq (eval res) 'nil)
     "Awe, too bad. Im sorry to hear that."
     )
    )
  )
Title: line from a point perpendicular to a line
Post by: SMadsen on June 08, 2004, 11:40:26 AM
Nil! Nil!
Title: line from a point perpendicular to a line
Post by: sinc on July 22, 2004, 01:26:57 AM
What about:

Code: [Select]

(defun c:perp2ent (/ entity pt)
  (while (setq entity (car (entsel "\nSelect entity: ")))
    (while
      (setq pt (getpoint "\nSelect point to draw perpendicular from: "))
       (entmake
(list '(0 . "LINE")
      (cons 10 pt)
      (cons 11 (vlax-curve-getClosestPointTo entity pt))
) ;_ list
       ) ;_ entmake
    ) ;_ while
  ) ;_ while
  (princ)
) ;_ defun



It can get a little bit funky if you try and draw perps to splines or polylines that curve back in on themselves, but otherwise it works.
Title: line from a point perpendicular to a line
Post by: sinc on July 22, 2004, 01:43:41 AM
Oh, and if you're past the end of the line/arc/whatever, it draws a line to the nearest endpoint...  I guess that's also why it gets funky if the splines/polylines curve back on themselves...
Title: line from a point perpendicular to a line
Post by: CAB on July 22, 2004, 08:13:34 AM
Wow that is cool.
I like it.... 8)
CAB
Title: line from a point perpendicular to a line
Post by: CAB on July 22, 2004, 08:21:25 AM
Ooops, one problem.
When i use this to rotate my view
Code: [Select]
^C^Cdview;;tw;90;;_ucs;w;_ucs;z;270;
It doesn't work. But I still like it.
Nice work.

CAB
Title: line from a point perpendicular to a line
Post by: CAB on July 22, 2004, 08:40:13 AM
Ok, it was an easy modification.
Works like a dream....
I replaced my old routine with this.
Thanks again.
CAB
Code: [Select]
;;  by sinc @ the Swamp  07/22/2004
;;  Repeatedly draws a line from a pick point perpendicular
;;  to a selected object
(defun c:perp2ent (/ entity pt)
  (while (setq entity (car (entsel "\nSelect entity: ")))
    (while
      (setq pt (getpoint "\nSelect point to draw perpendicular from: "))
       (entmake (list '(0 . "LINE") (cons 10 (trans pt 1 0))
          (cons 11 (vlax-curve-getClosestPointTo entity (trans pt 1 0)))) ;_ list
       ) ;_ entmake
    ) ;_ while
  ) ;_ while
  (princ)
) ;_ defun
Title: Re: line from a point perpendicular to a line
Post by: dan19936 on January 04, 2007, 08:53:11 PM
I wasn't sure if sinc's routine was useful but I had saved it anyway. Today I'm doing a spiral stair and it is so much more productive than polar array to just divide & pick the perpendicular points.

Thanks Sinc! (and CAB)

Dan
Title: Re: line from a point perpendicular to a line
Post by: CAB on January 04, 2007, 10:32:31 PM
I still use that routine today. :-)
Title: Re: line from a point perpendicular to a line
Post by: ronjonp on January 05, 2007, 09:59:17 AM
That routine is sweet :)...here's my addition to CAB's version, inputs lines on same layer as entity picked.

Code: [Select]
(defun c:perp2ent (/ entity pt lyr)
  (while (setq entity (car (entsel "\nSelect entity: ")))
    (while
      (setq pt (getpoint "\nSelect point to draw perpendicular from: "))
       (entmake
(list '(0 . "LINE")
       (cons 8 (cdr (assoc 8 (entget entity))))
       (cons 10 (trans pt 1 0))
       (cons 11
     (vlax-curve-getClosestPointTo entity (trans pt 1 0))
       )
)
       )
    )
  )
  (princ)
)
Title: Re: line from a point perpendicular to a line
Post by: alisafei on January 28, 2009, 03:05:06 PM
can you add the distance of the point from that selected line.
i want to check how far that point lies from that selected object.
thanks in advance.
Title: Re: line from a point perpendicular to a line
Post by: CAB on January 28, 2009, 03:35:39 PM
Welcome to TheSwamp.

Do you need the distance displayed on the command line or added to the drawing?
Title: Re: line from a point perpendicular to a line
Post by: DEVITG on January 28, 2009, 03:38:00 PM
Hi Ronjonp .

Sad to say that  if the point is "OUTSIDE" the line , it will draw the line to the end of the start of the lines.


Title: Re: line from a point perpendicular to a line
Post by: ronjonp on January 28, 2009, 04:18:56 PM
Hi Ronjonp .

Sad to say that  if the point is "OUTSIDE" the line , it will draw the line to the end of the start of the lines.




Not very pretty but this works:  8-)

Code: [Select]
(defun c:perp2ent (/ entity pt lyr ep sp ppt ang1 ang2 obj)
  (while (and (setq entity (car (entsel "\nSelect entity: ")))
              (setq obj (vlax-ename->vla-object entity))
         )
    (while (setq pt (getpoint "\nSelect point to draw perpendicular from: "))
      (setq sp   (vlax-curve-getstartpoint obj)
            ep   (vlax-curve-getendpoint obj)
            ppt  (vlax-curve-getclosestpointto entity (trans pt 1 0))
            ang1 (angle (vlax-curve-getpointatparam
                          obj
                          (+ (vlax-curve-getparamatpoint obj sp) 0.01)
                        )
                        sp
                 )
            ang2 (angle (vlax-curve-getpointatparam
                          obj
                          (* (vlax-curve-getparamatpoint obj ep) 0.99)
                        )
                        ep
                 )
      )
      (cond ((equal ppt sp 0.0001)
             (setq ppt (inters sp
                               (polar sp ang1 0.01)
                               pt
                               (polar pt (+ ang1 (/ pi 2.)) 0.01)
                               onseg
                       )
             )
             (if (= (vla-get-objectname obj) "AcDbLine")
               (vlax-put obj 'startpoint ppt)
             )
            )
            ((equal ppt ep 0.0001)
             (setq ppt (inters ep
                               (polar ep ang2 0.01)
                               pt
                               (polar pt (+ ang2 (/ pi 2.)) 0.01)
                               onseg
                       )
             )
             (if (= (vla-get-objectname obj) "AcDbLine")
               (vlax-put obj 'endpoint ppt)
             )
            )
      )
      (entmake (list '(0 . "LINE")
                     (cons 8 (cdr (assoc 8 (entget entity))))
                     (cons 10 (trans pt 1 0))
                     (cons 11 ppt)
               )
      )
    )
  )
  (princ)
)

Title: Re: line from a point perpendicular to a line
Post by: DEVITG on January 28, 2009, 04:27:17 PM
If work is pretty.

I did not notice that I 'm the original poster , about 4 years ago.

Thanks
Title: Re: line from a point perpendicular to a line
Post by: alisafei on January 29, 2009, 07:47:25 AM
Welcome to TheSwamp.

Do you need the distance displayed on the command line or added to the drawing?


thanks for your reply admin. i wanted like this one
 
X cordinate of the point (Northing)
----------------------------------  distance between point and that line (may be polyline or something)
Y co-ordinate of the point (Easting)

like

N-1000.000
----------- 23.52m
E-2000.000

i think if the distance added to drawing will be better.
i use this type of command in our highway design works. if you have time, please try to update the code.
thanks again.

thanks.
Title: Re: line from a point perpendicular to a line
Post by: Hugo on May 27, 2010, 10:41:49 AM
Kan this be changed so that I can enter a fixed line length.

Kan man das so ändern, das ich eine fixe Linienlänge eingeben kann.

Danke
Title: Re: line from a point perpendicular to a line
Post by: ronjonp on May 27, 2010, 03:56:53 PM
Here you go Hugo :). You can enter a fixed leg length or hit enter to work as before. Just did a re-write because the other version embarrassed me  :-D

Code: [Select]
(defun c:perp2ent (/ ang e ep len onseg p perp ppt pt sp x)
  (while
    (and (setq e (car (entsel "\nSelect a line: ")))
(= (cdr (assoc 0 (entget e))) "LINE")
(or (setq len (getdist "\Enter fixed leg length [Enter for none]:")) (setq len 0))
    )
     (while (setq pt (getpoint "\nPick a point to draw perpendicular line: "))
       (setq sp   (cdr (assoc 10 (entget e)))
     ep   (cdr (assoc 11 (entget e)))
     ppt  (vlax-curve-getclosestpointto e pt)
     ang  (angle '(0 0) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e ppt)))
     perp (+ ang (/ pi 2.))
       )
       (if
(setq p (car (vl-remove-if-not '(lambda (x) (equal x ppt 0.001)) (list sp ep))))
  (progn (setq ppt (inters sp (polar sp ang 0.01) pt (polar pt perp 0.01) onseg))
(entmod (mapcar '(lambda (x)
    (cond ((equal x (cons 10 p) 0.001) (cons 10 ppt))
  ((equal x (cons 11 p) 0.001) (cons 11 ppt))
  (x)
    )
  )
(entget e)
)
)
  )
       )
       (entmake (list '(0 . "LINE")
      (cons 8 (cdr (assoc 8 (entget e))))
      (if (zerop len)
(cons 10 pt)
(cons 10 (polar ppt (angle ppt pt) len))
      )
      (cons 11 ppt)
)
       )
     )
  )
  (princ)
)
Title: Re: line from a point perpendicular to a line
Post by: Lee Mac on May 27, 2010, 07:29:42 PM
Its a shame GrRead doesn't make this a viable solution - nice code Ron, I hacked this a bit  :|

Code: [Select]
(defun c:perp2ent ( / ang e ep len onseg p perp ppt pt sp x )
  (vl-load-com)
  ;; By LISP Guru RonJonP, dynamically tweaked by Mr Lee Mac
 
  (while (and (setq e (car (entsel "\nSelect a line: ")))
      (= (cdr (assoc 0 (entget e))) "LINE")
      (or (setq len (getdist "\Enter fixed leg length [Enter for none]:")) (setq len 0)))

    (while (and (vl-position (car (setq gr (grread 't 13 0))) '( 5 3 )) (listp (setq pt (cadr gr))))
      (redraw)

      (if (= 5 (car gr))
        (progn
          (setq sp    (cdr (assoc 10 (entget e))) ep (cdr (assoc 11 (entget e)))
                ppt  (vlax-curve-getclosestpointto e pt)
                ang  (angle '(0. 0.) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e ppt)))
                perp (+ ang (/ pi 2.)))

          (if (setq p (car (vl-remove-if-not (function (lambda (x) (equal x ppt 0.001))) (list sp ep))))
            (progn
              (setq ppt (inters sp (polar sp ang 0.01) pt (polar pt perp 0.01) onseg))

              (grdraw ppt (car (vl-sort (list sp ep) '(lambda ( a b ) (< (distance a ppt) (distance b ppt))))) 1 1)
            )
          )
          (grdraw (if (zerop len) pt (polar ppt (angle ppt pt) len)) ppt 1 1)
        )
        (progn
          (setq sp   (cdr (assoc 10 (entget e))) ep (cdr (assoc 11 (entget e)))
                ppt  (vlax-curve-getclosestpointto e pt)
                ang  (angle '(0. 0.) (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e ppt)))
                perp (+ ang (/ pi 2.)))
         
          (if (setq p (car (vl-remove-if-not (function (lambda (x) (equal x ppt 0.001))) (list sp ep))))
            (progn
              (setq ppt (inters sp (polar sp ang 0.01) pt (polar pt perp 0.01) onseg))
             
              (entupd
                (cdr
                  (assoc -1
                    (entmod
                      (mapcar
                        (function
                          (lambda ( x )
                            (cond
                              ((equal x (cons 10 p) 0.001) (cons 10 ppt))
                              ((equal x (cons 11 p) 0.001) (cons 11 ppt))
                              ( x )
                            )
                          )
                        )
                        (entget e)
                      )
                    )
                  )
                )
              )
            )
          )
          (entmake
            (list
              (cons 0 "LINE")
              (cons 8 (cdr (assoc 8 (entget e))))
              (if (zerop len)
                (cons 10 pt)
                (cons 10 (polar ppt (angle ppt pt) len))
              )
              (cons 11 ppt)
            )
          )
        )
      )
    )
    (redraw)
  )
  (princ)
)
Title: Re: line from a point perpendicular to a line
Post by: CAB on May 27, 2010, 09:43:36 PM
My humble offering.
Code: [Select]
(defun c:p2e (/ ang intpt ent p1 p2 p3 p4 len)
  ;;  global  *LR_elast*
  (defun 3dP->2dP (3dpt)(list (car 3dpt) (cadr 3dpt))) ;Make 2D point from 3D point
  (setq len (getdist "\Enter fixed leg length [Enter for none]:"))
  (if (or (setq ent (entsel "\nSelect base line: "))
          (setq ent *LR_elast*))
    (if (= "LINE" (cdr (assoc 0 (setq ent (entget (car ent))))))
      (progn
        (setq *LR_elast* (list (cdr (assoc -1 ent)) 1)) ; save ename in a list
        (setq p1  (3dP->2dP(cdr (assoc 10 ent)))
              p2  (3dP->2dP(cdr (assoc 11 ent)))
              ang (angle p1 p2)
        )
        (while (setq p3 (getpoint "\nSelect point to draw perpendicular from, Enter to quit: "))
          (setq p3 (3dP->2dP(trans p3 1 0))) ; adjust for non-World UCS
          (setq p4 (polar p3 (+ ang (/ pi 2)) 100))
          (setq intpt (inters p1 p2 p3 p4 nil))
          (if len (setq intpt (polar p3 (angle p3 intpt) len)))
          (entmake (list '(0 . "LINE") (cons 10 p3) (cons 11 intpt)))
        ) ; end while
      ) ; progn
      (prompt "\nObject is not a LINE.")
    ) ; endif
    (prompt "\nNothing Selected.")
  ) ; endif
  (princ)
)
Title: Re: line from a point perpendicular to a line
Post by: ronjonp on May 28, 2010, 12:40:35 AM
Its a shame GrRead doesn't make this a viable solution - nice code Ron, I hacked this a bit  :|

.....

Nice mod Lee  8-) and thanks for the praise (although I'm just a hacker  ;-)) I've kinda given up on grread until osnaps are a workable option. They do have cool factor though  :-)

btw ... it's nice to see you may have joined "the darkside" with your code formatting.  :lmao:
Title: Re: line from a point perpendicular to a line
Post by: ronjonp on May 28, 2010, 12:48:14 AM
CAB,

I could not get your code to work correctly?
Title: Re: line from a point perpendicular to a line
Post by: Hugo on May 28, 2010, 12:53:03 AM
Thanks to all
@ Cab
code is not ok.


Danke an alle
@ cab
code ist nicht ok.
Title: Re: line from a point perpendicular to a line
Post by: Kerry on May 28, 2010, 12:56:34 AM
Alan is celebrating his birthday, so cut the guy some slack, OK !!  :wink:
Title: Re: line from a point perpendicular to a line
Post by: ronjonp on May 28, 2010, 12:57:48 AM
Alan is celebrating his birthday, so cut the guy some slack, OK !!  :wink:

OK ..I'll let it slide THIS time :P
Title: Re: line from a point perpendicular to a line
Post by: Lee Mac on May 28, 2010, 06:03:11 AM
btw ... it's nice to see you may have joined "the darkside" with your code formatting.  :lmao:

Haha - yes, peer pressure got the better of me  :wink:  :-P  I think I actually prefer it now lol
Title: Re: line from a point perpendicular to a line
Post by: CAB on May 28, 2010, 07:33:09 AM
Thanks Kerry, works for me but no more time to test it. Maybe tonight.
Title: Re: line from a point perpendicular to a line
Post by: alanjt on May 28, 2010, 09:53:57 AM
I want to play :)....

Code: [Select]
(defun c:PTL (/ ent dist pt)
  ;; Alan J. Thompson, 05.28.10
  (while (and (setq ent (car (entsel "\nSelect curve: ")))
              (eq "LINE" (cdr (assoc 0 (entget ent))))
              (setq dist (cond ((getdist "\nSpecify distance <None>: "))
                               (0.)
                         )
              )
         )
    (while (setq pt (getpoint "\nSpecify point for line: "))
      (setq pt (trans pt 1 0))
      ((lambda (pol)
         (entmake (list '(0 . "LINE")
                        (cons 10 pol)
                        (cons 11
                              (cond ((zerop dist) pt)
                                    ((polar pol (angle pol pt) dist))
                              )
                        )
                  )
         )
         ((lambda (lst / lst)
            (if (< (apply (function distance) lst)
                   (distance pol
                             (car (setq lst
                                         (vl-sort lst
                                                  (function (lambda (a b) (> (distance a pol) (distance b pol))))
                                         )
                                  )
                             )
                   )
                )
              (entmod (mapcar (function (lambda (x)
                                          (if (equal (cdr x) (cadr lst))
                                            (cons (car x) pol)
                                            x
                                          )
                                        )
                              )
                              (entget ent)
                      )
              )
            )
          )
           (list (vlax-curve-getEndPoint ent) (vlax-curve-getStartPoint ent))
         )
       )
        (vlax-curve-getClosestPointTo ent pt T)
      )
    )
  )
  (princ)
)
Title: Re: line from a point perpendicular to a line
Post by: alanjt on May 28, 2010, 10:03:17 AM
 :lol:

Code: [Select]
(defun c:test (/ ent)
  (if (setq ent (entsel "\nSelect curve: "))
    (while (vl-cmdf "_.line" "_per" (cadr ent) PAUSE ""))
  )
  (princ)
)
Title: Re: line from a point perpendicular to a line
Post by: ronjonp on May 28, 2010, 11:14:05 AM
Well I think Hugo has a nice selection to choose from now  :-)
Title: Re: line from a point perpendicular to a line
Post by: alanjt on May 28, 2010, 11:33:13 AM
Well I think Hugo has a nice selection to choose from now  :-)
I hope I didn't step on your toes, Ron. I was just joining in on the fun.
Title: Re: line from a point perpendicular to a line
Post by: ronjonp on May 28, 2010, 12:09:25 PM
Well I think Hugo has a nice selection to choose from now  :-)
I hope I didn't step on your toes, Ron. I was just joining in on the fun.

Not at all  ... I actually enjoy seeing how other people solve problems :)
Title: Re: line from a point perpendicular to a line
Post by: alanjt on May 28, 2010, 01:02:46 PM
Well I think Hugo has a nice selection to choose from now  :-)
I hope I didn't step on your toes, Ron. I was just joining in on the fun.

Not at all  ... I actually enjoy seeing how other people solve problems :)
Good deal. I just didn't want to offend. :)



Just for additional fun, here's one that will fix the line to always display text linetypes readable.
(http://www.theswamp.org/screens/alanjt/ptl.gif)

Code: [Select]
(defun c:PTL (/ ent dist pt dxf)
  ;; Alan J. Thompson, 05.28.10
  (while (and (setq ent (car (entsel "\nSelect curve: ")))
              (eq "LINE" (cdr (assoc 0 (entget ent))))
              (setq dist (cond ((getdist "\nSpecify distance <None>: "))
                               (0.)
                         )
              )
         )
    (while (setq pt (getpoint "\nSpecify point for line: "))
      (setq pt (trans pt 1 0))
      ((lambda (pol)
         ((lambda (ang)
            (if (and (> ang (* pi 0.5)) (< ang (* pi 1.5)))
              (setq dxf '(10 11))
              (setq dxf '(11 10))
            )
          )
           (angle pol pt)
         )
         (entmake (list '(0 . "LINE")
                        (cons (cadr dxf) pol)
                        (cons (car dxf)
                              (cond ((zerop dist) pt)
                                    ((polar pol (angle pol pt) dist))
                              )
                        )
                  )
         )
         ((lambda (lst / lst)
            (if (< (apply (function distance) lst)
                   (distance pol
                             (car (setq lst
                                         (vl-sort lst
                                                  (function (lambda (a b) (> (distance a pol) (distance b pol))))
                                         )
                                  )
                             )
                   )
                )
              (entmod (mapcar (function (lambda (x)
                                          (if (equal (cdr x) (cadr lst))
                                            (cons (car x) pol)
                                            x
                                          )
                                        )
                              )
                              (entget ent)
                      )
              )
            )
          )
           (list (vlax-curve-getEndPoint ent) (vlax-curve-getStartPoint ent))
         )
       )
        (vlax-curve-getClosestPointTo ent pt T)
      )
    )
  )
  (princ)
)
Title: Re: line from a point perpendicular to a line
Post by: Hugo on May 28, 2010, 03:02:15 PM
Thanks to all of you since the best


Danke an alle, ihr seit die Besten
 :-) :-) :-)
Title: Re: line from a point perpendicular to a line
Post by: chlh_jd on March 09, 2011, 02:56:18 AM
hi , here based on Alan.J.T codes , I add osnap method and used in block
Code: [Select]
;;; Draw perpendicular line
;;; Alan J. Thompson, 10.15.09
;;; Edited by GSLS(SS) 2011-03-08
(defun c:Lper (/ foo ss-errexit #Ent #Read pt p0 ang ent blk?)
  (defun foo (/ is_go lst mid mod)
    (setq pt (osnap (cadr #read)
   "_end,_mid,_cen,_nod,_int,_tan,_per,_nea"
    )
    )
    (if pt
      (progn
(setq is_go T
     lst
      '("_end" "_mid" "_cen" "_nod" "_int" "_tan" "_per" "_nea")
)
(while (and is_go lst)
 (setq mid (car lst)
lst (cdr lst)
 )
 (if (equal pt (osnap (cadr #read) mid))
   (setq mod mid
 is_go nil
   )
 )
)
(if mod
 (osMark (list pt mod (cadr #read)))
)
      )
    )
    (or pt (setq pt (cadr #Read)))
    (setq pt (trans pt 1 0))
    (setq p0 (vlax-curve-getclosestpointto #Ent pt T))
  ) ;_Add osmark
  ;;line-ang
  ;;by Lee Mac
  (defun line-ang (p0 ang / ent #read)
    (setq ent
  (entget
    (entmakex (list (cons 0 "LINE") (cons 10 p0) (cons 11 p0)))
  )
    )
    (while (= 5 (car (setq #Read (grread T 13 0))))
      (entupd
(cdr
 (assoc
   -1
   (entmod
     (list
(assoc -1 ent)
(cons
 11
 (trans
   (polar
     p0
     ang
     ((if (minusp
    ((lambda (n)
(- (caddr (trans (cadr #read) 1 n))
  (caddr (trans p0 1 n))
)
     )
      (polar '(0. 0. 0.) ang 1.)
    )
  )
-
+
      )
(distance p0 (cadr #read))
     )
   )
   1
   0
 )
)
     )
   )
 )
)
      )
    )
  )
  (defun ss-errexit (msg)
    (command)
    (command)
    (if (or (= msg "Function cancelled")
   (= msg "quit / exit abort")
)
      (princ msg)
      (princ (strcat "\n错误: " msg))
    )
    (if blk?
      (entdel #ent)
    )
    (clos)
  )
  (svos)
  (setq #Ent (ss-Nentsel "\n选择曲线: ")) ;_support block
  (setq blk? (last #Ent)
#Ent (car #Ent)
  )
  (if (and #ent
  (vl-position
    (cdr (assoc 0 (entget #Ent)))
    '("LWPOLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE" "SPLINE")
  )
      )
    (while (and (/= 25 (car (setq #Read (grread T 1 1))))
(/= (car #Read) 11)
(/= (car #Read) 2)
  )
      (princ "\r选择点: ")
      (redraw)
      (if (vl-consp (cadr #Read))
(foo)
      )
      (if p0
(grdraw p0
(trans pt 1 0)
1
) ;_ grdraw
      ) ;_ if      
      (if (and (eq 3 (car #Read)) (foo))
(if (not (equal pt p0 1e-6))
 (entmake
   (list
     '(0 . "LINE")
     (cons 10
   p0
     )
     (cons 11 pt)
   ) ;_ list
 ) ;_ entmake
 (progn ;_ the part writen by Lee Mac
   (setq ang (+ (xyp-get-AngleAtPoint #Ent p0) _pi2))
   (line-ang p0 ang)
 )
)
      ) ;_ if
    ) ;_ while    
  ) ;_ if
  (redraw)
  (clos)
  (princ)
) ;_ defun
;;;save old sysvar
(defun svos ()
  (setq #system#    '("OSMODE"     "ORTHOMODE"    "CLAYER"
     "CECOLOR"     "PLINEWID"    "CELTYPE"
     "CMDECHO"     "ELEVATION"    "PICKSTYLE"
    )
#vlale#    (mapcar 'getvar #system#)
gsls_olderr *error*
*error*    ss-errexit
  )
  (vla-startundomark
    (vla-get-activedocument (vlax-get-acad-object))
  )
)
;;;---------------------------------------------------------------------;;;
;;;call old sysvar
(defun clos ()
  (vla-EndUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  )
  (MapCar 'setvar #system# #vlale#)
  (setq *error* gsls_olderr)
)
;;; Nentsel
;;; function : to nentsel a entity In situ
;;; arg      : string to princ in command-line
;;; return   : a list ( ename point is-of-block? )
;;; Note     : if the ename is of a block , the routine copy a similar entity , so you must entdel it later
;;; by GSLS(SS)
;;;
(defun ss-Nentsel (msg / en en1 pt mat ins mat ent)
  (setq en (Nentsel msg))
  (if (= (length en) 4)
    (progn
      (setq en1 (car en)
   pt (cadr en)
   mat (caddr en)
   ins (last mat)
   mat (reverse (cdr (reverse mat)))
   mat ((append
  (mapcar '(lambda (x y)
     (append x (list y))
   )
  mat
  ins
  )
  '((0. 0. 0. 1.))
)
)
      )
      (setq ent (entget en1 '("*")))
      (setq ent (vl-remove (assoc -1 ent) ent))
      (setq en1 (entmakex ent)) ;_make a new similar entity !!!
      (if en1
(progn
 (setq obj (vlax-ename->vla-object en1))
 (vla-TransformBy obj (vlax-tmatrix mat))
 (setq en1 (vlax-vla-object->ename obj))
)
      )
      (list en1 pt T)
    )
    (append en (list nil))
  )
)
;;;by xyp1964
(defun xyp-get-AngleAtPoint (ename point / oname p1 v1 pt-ang)
  (setq oname (vlax-ename->vla-object ename))
  (setq v1     (vlax-curve-getfirstderiv
oname
(vlax-curve-getparamatpoint oname point)
      )
p1     (mapcar '+ point v1)
pt-ang (angle point p1)
  )
  (vlax-release-object oname)
  pt-ang
)
;;;osmark by Evgeniy
(defun osMark (o / s drft osGrv)
  (setq s (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))
o (cons (trans (car o) 1 3) (cdr o))
  )
  (setq osGrv (osmode-grvecs-lst
(vla-get-AutoSnapMarkerColor
 (setq drft (vla-get-drafting
      (vla-get-preferences
(vlax-get-acad-object)
      )
    )
 )
)
(vla-get-AutoSnapMarkerSize drft)
     )
  )
  (grvecs (cdr (assoc (cadr o) osGrv))
 (list (list s 0. 0. (caar o))
(list 0. s 0. (cadar o))
(list 0. 0. s (caddar o))
(list 0. 0. 0. 1.)
 )
  )
)
about osmark you can see here
http://www.theswamp.org/index.php?topic=12813.0