0 Members and 1 Guest are viewing this topic.
Look into vlax-curve-getclosestpointto.(vlax-curve-getclosestpointto (car (entsel)) (getpoint))
Worked for me in both examples.
Coder,I thought you said you did not have any lines to pick, just the two points?
(defun c:test (/ _line _foo _per e l1 l2 p1 p2 p3 p4) (vl-load-com) (defun _per (p1 p2) (+ (/ pi 2.) (angle p1 p2))) (defun _line (p1 p2 layer) (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") (cons 8 layer) '(100 . "AcDbLine") (cons 10 p1) (cons 11 p2) ) ) ) (defun _foo (p / i p1 p2 p3) (if (and (setq e (car (nentselp p))) (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list e)))) (setq p1 (vlax-curve-getclosestpointto e (trans p 1 0))) (setq i (vlax-curve-getparamatpoint e p1)) (setq p2 (vlax-curve-getpointatparam e (fix i))) (setq p3 (vlax-curve-getpointatparam e (1+ (fix i)))) ) (list p1 p2 p3) ) ) (if (and (setq p1 (getpoint "\n1st point: ")) (setq p2 (getpoint "\n2nd point: " p1)) (setq l1 (_foo p1)) (setq l2 (_foo p2)) ) (progn (setq p4 (inters (car l1) (polar (car l1) (_per (cadr l1) (caddr l1)) 0.1) (cadr l2) (caddr l2) nil ) ) (setq p3 (inters (car l2) (polar (car l2) (_per (cadr l2) (caddr l2)) 0.1) (cadr l1) (caddr l1) nil ) ) (and p3 (_line p3 p2 "Foo")) (and p4 (_line p1 p4 "Foo")) ) ) (princ))
Give this a try:
(defun c:test ( / p1 p2 e1 e2 ss1 ss2 n pp p1 p2 p3 p4) (vl-load-com) (if (and (setq p1 (getpoint "\n1st point: ")) (setq p2 (getpoint P1 "\n2nd point: ")) ) (progn (setq e1 (ssget "_C" p1 p1 '((0 . "LINE")))) (setq e2 (ssget "_C" p2 p2 '((0 . "LINE")))) (repeat (setq n (sslength e1)) (setq ss1 (cons (ssname e1 (setq n (1- n))) ss1)) ) (repeat (setq n (sslength e2)) (setq ss2 (cons (ssname e2 (setq n (1- n))) ss2)) ) (foreach x ss1 (if (member x ss2 ) (progn (setq ss1 (vl-remove x ss1)) (setq ss2 (vl-remove x ss2)) ) ) ) (foreach x ss1 (setq pp (cons (vlax-curve-getClosestPointTo x p2) pp)) ) (foreach x ss2 (setq pp (cons (vlax-curve-getClosestPointTo x p1) pp)) ) (if (= 2 (length (setq pp (LM:UniqueFuzz pp 1e-6)))) (progn (setq p3 (car pp) p4 (cadr pp)) (if (> (distance p1 p3) (distance p1 p4)) (setq p3 p4 p4 (car pp)) ) (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p4))) (entmake (list '(0 . "LINE") (cons 10 p2) (cons 11 p3))) ) ) ) ) (princ));; Unique with Fuzz - Lee Mac;; Returns a list with all elements considered duplicate to;; a given tolerance removed.(defun LM:UniqueFuzz ( l f / x r ) (while l (setq x (car l) l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l)) r (cons x r) ) ) (reverse r))
Give this a try (2):