Author Topic: line from a point perpendicular to a line  (Read 31065 times)

0 Members and 1 Guest are viewing this topic.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: line from a point perpendicular to a line
« Reply #45 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)
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: line from a point perpendicular to a line
« Reply #46 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)
)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: line from a point perpendicular to a line
« Reply #47 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)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: line from a point perpendicular to a line
« Reply #48 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:
« Last Edit: May 28, 2010, 12:45:12 AM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

ronjonp

  • Needs a day job
  • Posts: 7526
Re: line from a point perpendicular to a line
« Reply #49 on: May 28, 2010, 12:48:14 AM »
CAB,

I could not get your code to work correctly?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Hugo

  • Bull Frog
  • Posts: 422
Re: line from a point perpendicular to a line
« Reply #50 on: May 28, 2010, 12:53:03 AM »
Thanks to all
@ Cab
code is not ok.


Danke an alle
@ cab
code ist nicht ok.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: line from a point perpendicular to a line
« Reply #51 on: May 28, 2010, 12:56:34 AM »
Alan is celebrating his birthday, so cut the guy some slack, OK !!  :wink:
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: line from a point perpendicular to a line
« Reply #52 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

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: line from a point perpendicular to a line
« Reply #53 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

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: line from a point perpendicular to a line
« Reply #54 on: May 28, 2010, 07:33:09 AM »
Thanks Kerry, works for me but no more time to test it. Maybe tonight.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: line from a point perpendicular to a line
« Reply #55 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)
)
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: line from a point perpendicular to a line
« Reply #56 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)
)
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

ronjonp

  • Needs a day job
  • Posts: 7526
Re: line from a point perpendicular to a line
« Reply #57 on: May 28, 2010, 11:14:05 AM »
Well I think Hugo has a nice selection to choose from now  :-)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: line from a point perpendicular to a line
« Reply #58 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.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

ronjonp

  • Needs a day job
  • Posts: 7526
Re: line from a point perpendicular to a line
« Reply #59 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 :)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC