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)))
)
)
)