See the top rated post in this thread. Click here

Page 2 of 2 FirstFirst 12
Results 11 to 18 of 18

Thread: Perpendicular 2D snap to line

  1. #11
    AUGI Addict fixo's Avatar
    Join Date
    2005-05
    Location
    Pietari, Venäjä
    Posts
    1,269
    Login to Give a bone
    1

    Default Re: Perpendicular 2D snap to line

    Found this function on russian forum, not tested,
    see comments
    Code:
    ; The intersection of line and plane
    , -------------------------------------
    ; Arguments:
    ; P1, P2 - line points
    ; Ppl - any point in the plane
    ; WNorm - vector normal to the plane
    ; Returns: The intersection of line and plane, or nil
    (defun 3d_inters_lnpl (P1 P2 Ppl WNorm / A B C D L M N Tpr V)
     (mapcar 'set '(L M N) (mapcar '- P2 P1)) ; line vector
     (mapcar 'set '(A B C) WNorm)
     (if (not (equal (setq V (+ (* A L) (* B M) (* C N))) 0.0 $fuzz));<-- change $fuzz to suit----------------------------------
      (progn
       (setq D (- (+ (* A (car Ppl)) (* B (cadr Ppl)) (* C (caddr Ppl))))
    	 Tpr (- (/ (+ (* A (car P1)) (* B (cadr P1)) (* C (caddr P1)) D) V))
       )
       (list (+ (car P1) (* Tpr L)) (+ (cadr P1) (* Tpr M)) (+ (caddr P1) (* Tpr N)))
      )
     )
    )
    Regards,

  2. #12
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Perpendicular 2D snap to line

    Quote Originally Posted by fixo View Post
    Found this function on russian forum, not tested,
    see comments

    Regards,
    Thanks fixo, that did the trick! This code tested while in the line, dist, and polyline commands.
    Code:
     ; 2D Perpendicular osnap to a line.
    ; Tom Beauford
    ;Macro ^P(or PerpEnt (load "PerpEnt.lsp"))(PerpEnt);
     (defun PerpEnt (/ *error* pt ent el pt1 pt2 pt5 ent2 el2)
    
      (defun *error* (msg)
        (cond ((not msg))                                                   ; Normal exit
              ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
              ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
        )
        (princ)
      )
    
      (setq ent (entsel)
          pt (cadr ent)
          ent (car ent)
          el (entget ent)
          pt1 (assoc 10 el)
          pt2 (assoc 11 el)
          pt1 (cdr pt1)
          pt2 (cdr pt2)
          lpt (getvar 'lastpoint)
          ang (angle pt1 pt2)
          dst (distance pt1 pt2)
          nrml (polar '(0.0 0.0 0.0) ang dst)
          nrml (reverse(cons 0.0(cdr(reverse nrml))))
          pt5 (3d_inters_lnpl pt1 pt2 lpt nrml)
      )
      (setvar 'lastpoint pt5)
      (vl-cmdf "PER" pt)
      (if (= "LINE" (getvar 'CMDNAMES))
          (progn
              (setq ent2 (entlast)
    	      el2 (entget ent2)
    	      el2 (subst (cons 11 pt5) (assoc 11 el2) el2)
              )
    	  (entmod el2)
    	  (command "" "" pt5)
          )
          (command pt5)
      )
      (while (= 1 (logand 1 (getvar 'cmdactive))) ; PAUSE while command is active
        (vl-cmdf PAUSE)
      );while
      (princ)
    )
    ; The intersection of line and plane
    , -------------------------------------
    ; Arguments:
    ; P1, P2 - line points
    ; Ppl - any point in the plane
    ; WNorm - vector normal to the plane
    ; Returns: The intersection of line and plane, or nil
    (defun 3d_inters_lnpl (P1 P2 Ppl WNorm / A B C D L M N Tpr V)
     (mapcar 'set '(L M N) (mapcar '- P2 P1)) ; line vector
     (mapcar 'set '(A B C) WNorm)
    ; (if (not (equal (setq V (+ (* A L) (* B M) (* C N))) 0.0 $fuzz));<-- change $fuzz to suit----------------------------------
     (if (/= (setq V (+ (* A L) (* B M) (* C N))) 0.0)
      (progn
       (setq D (- (+ (* A (car Ppl)) (* B (cadr Ppl)) (* C (caddr Ppl))))
    	 Tpr (- (/ (+ (* A (car P1)) (* B (cadr P1)) (* C (caddr P1)) D) V))
       )
       (list (+ (car P1) (* Tpr L)) (+ (cadr P1) (* Tpr M)) (+ (caddr P1) (* Tpr N)))
      )
     )
    )

  3. #13
    AUGI Addict
    Join Date
    2008-02
    Posts
    1,141
    Login to Give a bone
    0

    Default Re: Perpendicular 2D snap to line

    Tom, unless I'm missing something, wouldn't this do the trick?

    Code:
    (defun c: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)
                             )
                   )
              )
            (trans pnt ent 1)
          )
        )
        (alert "** Command must be executed transparently! **")
      )
    )
    Call it transparently, once you executed the line/pline/etc. command.

  4. #14
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Perpendicular 2D snap to line

    Quote Originally Posted by alanjt View Post
    Tom, unless I'm missing something, wouldn't this do the trick?
    I drew a line from 0,0 to 4,3,10 and tried 'ppp while drawing another line and snaping to it. It returned a different result than mine or Per? Did not have any elevation on the endpoint either. Is it for snaping to something other than a line? I use ^P(or PerpEnt (load "PerpEnt.lsp"))(PerpEnt); in a macro for the line/pline/dist prompts.

  5. #15
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Perpendicular 2D snap to line

    Turned off osnaps and tried it again and it worked!
    Nice I'll add a couple lines to toggle off the osnaps.

  6. #16
    AUGI Addict
    Join Date
    2008-02
    Posts
    1,141
    Login to Give a bone
    0

    Default Re: Perpendicular 2D snap to line

    Quote Originally Posted by Tom Beauford View Post
    Turned off osnaps and tried it again and it worked!
    Nice I'll add a couple lines to toggle off the osnaps.
    Try this:

    Code:
    (defun c: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)
    )

  7. #17
    Certifiable AUGI Addict
    Join Date
    2001-03
    Location
    Tallahassee, FL USA
    Posts
    3,658
    Login to Give a bone
    0

    Default Re: Perpendicular 2D snap to line

    Quote Originally Posted by alanjt View Post
    Try this:
    That did the trick! My personal preference will be to take out the c: and call with (PPP) in a macro in my Object Snap Cursor Menu. That way I don't get alert "** Command must be executed transparently! **" when I hit enter to restart the line/pline/etc. command.
    Thanks Alan, owe you a beer!

  8. #18
    AUGI Addict
    Join Date
    2008-02
    Posts
    1,141
    Login to Give a bone
    0

    Default Re: Perpendicular 2D snap to line

    Quote Originally Posted by Tom Beauford View Post
    That did the trick! My personal preference will be to take out the c: and call with (PPP) in a macro in my Object Snap Cursor Menu. That way I don't get alert "** Command must be executed transparently! **" when I hit enter to restart the line/pline/etc. command.Thanks Alan, owe you a beer!
    Change it however best suites you. One of these days I'm going to have to stop in to Public works and say hello.

Page 2 of 2 FirstFirst 12

Similar Threads

  1. Multileader snap perpendicular to arc
    By Wish List System in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2012-06-12, 06:00 PM
  2. Perpendicular & nearest won't snap to arc
    By gadjet in forum AutoCAD General
    Replies: 4
    Last Post: 2007-05-08, 07:13 AM
  3. Replies: 5
    Last Post: 2006-11-09, 07:19 PM
  4. Perpendicular Object Snap
    By SHEILA in forum ACA General
    Replies: 6
    Last Post: 2004-10-06, 06:41 PM
  5. Deferred Perpendicular Snap
    By rpetrie in forum AutoCAD General
    Replies: 3
    Last Post: 2004-10-04, 07:13 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •