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,
Re: Perpendicular 2D snap to line
Quote:
Originally Posted by
fixo
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)))
)
)
)
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.
Re: Perpendicular 2D snap to line
Quote:
Originally Posted by
alanjt
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.
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.
Re: Perpendicular 2D snap to line
Quote:
Originally Posted by
Tom Beauford
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)
)
Re: Perpendicular 2D snap to line
Quote:
Originally Posted by
alanjt
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!
Re: Perpendicular 2D snap to line
Quote:
Originally Posted by
Tom Beauford
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.