Topic: Find opposite points diagonally

[Lee Mac]

Look into vlax-curve-getclosestpointto.
(vlax-curve-getclosestpointto (car (entsel)) (getpoint))

Agreed, something like this perhaps:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / e1 e2 p1 p2 )
2.     (if
3.         (and
4.             (setq p1 (getpoint "\n1st point: "))
5.             (setq p2 (getpoint "\n2nd point: " p1))
6.         )
7.         (if
8.             (and
9.                 (setq e1 (car (nentselp p1)))
10.                 (setq e2 (car (nentselp p2)))
11.             )
12.             (mapcar
13.                '(lambda ( a b )
14.                     (entmake
15.                         (list
16.                            '(0 . "POINT")
17.                             (cons 10 (vlax-curve-getclosestpointto a (trans b 1 0)))
18.                         )
19.                     )
20.                 )
21.                 (list e1 e2)
22.                 (list p2 p1)
23.             )
24.             (princ "\nNo object found at one or both of the selected points.")
25.         )
26.     )
27.     (princ)
28. )
29. (vl-load-com) (princ)

[ymg]

If I understand correctly, all he needs is to specify the diameter of the pipe,
or thickness of the wall as CAB said.

Otherwise there is an infinity of solutions.

ymg

[Coder]

Thank you so much for your replies

Lee your routine works on section A only 

I attach one drawing .

[CAB]

Worked for me in both examples.

[Coder]

Worked for me in both examples.

Thanks for trying CAB .

On section A it puts the points on p3 and p4 and that is very good .
On section B it puts the points on p1 and p2 and that is not correct to me .

Many thanks

[ronjonp]

Coder,

Lee is using vlax-curve-getclosestpointto in his example. If you have one closed object the the closest point will always be the same as your pick point. I thought you said you did not have any lines to pick, just the two points?

[Coder]

Coder,
I thought you said you did not have any lines to pick, just the two points?

That is correct , I need to pick two points , Lee codes works on section A but not on section B ( see attached drawing I uploaded lately )

Thank you ronjonp .

[ronjonp]

Give this a try:

Code: [Select]

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

[Coder]

Give this a try:

That worked very good on section B   

Thank you so much ronjonp

[ronjonp]

You're welcome. 

[GP]

Give this a try (2):

 

Code: [Select]

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

[Coder]

Give this a try (2):

 

That is perfect 

Thank you so much .

[GP]

You're welcome, Coder.