Topic: aobut auto extend

[dussla]

always thank you for many help
i need help some ~~
sorry many ask ~~ really sorry

my wonder issuse

if you see attach  image file  , you can see   image

there is many broken  lines ,   if i  select    circles ,      lines is extended  in circel areas
is that possible ?

multi area extend lisp

[ribarm]

Maybe something like this :

Code: [Select]

(defun c:extlinsinscircles ( / adoc *error* nolst putstart putend seg fuzz ss i sss curve m pt ptlst ii zz n ent entl curvetst curves pttlst ssbb ci enl ml ip l1 l2 )

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

  (defun *error* ( msg )
    (vla-endundomark adoc)
    (if msg (prompt msg))
    (princ)
  )

  (defun nolst ( st en / lst )
    (repeat (- en st)
      (setq st (1+ st))
      (setq lst (cons st lst))
    )
    (reverse lst)
  )

  (defun putstart ( ent pt / vtx )
    (cond
      ( (eq (cdr (assoc 0 (entget ent))) "LINE")
        (vla-put-startpoint (vlax-ename->vla-object ent) (vlax-3d-point pt))
      )
      ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
        (entupd (cdr (assoc -1 (entmod (subst (cons 10 (mapcar '+ '(0.0 0.0) pt)) (assoc 10 (entget ent)) (entget ent))))))
      )
      ( (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
        (setq vtx (entnext ent))
        (entupd (cdr (assoc -1 (entmod (subst (cons 10 pt) (assoc 10 (entget vtx)) (entget vtx))))))
        (entupd ent)
      )
    )
  )

  (defun putend ( ent pt / vtx )
    (cond
      ( (eq (cdr (assoc 0 (entget ent))) "LINE")
        (vla-put-endpoint (vlax-ename->vla-object ent) (vlax-3d-point pt))
      )
      ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
        (entupd (cdr (assoc -1 (entmod (subst (cons 10 (mapcar '+ '(0.0 0.0) pt)) (assoc 10 (reverse (entget ent))) (entget ent))))))
      )
      ( (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
        (setq vtx (entnext ent))
        (while (/= (cdr (assoc 0 (entget (entnext (setq vtx (entnext vtx)))))) "SEQEND"))
        (entupd (cdr (assoc -1 (entmod (subst (cons 10 pt) (assoc 10 (entget vtx)) (entget vtx))))))
        (entupd ent)
      )
    )
  )

  (vla-startundomark adoc)
  (alert "Select continously circle groups one by one and when finished press ESC...")
  (command "_.UCS" "_W")
  (setq seg 100 fuzz 1e-4)
  (prompt "\nSelect lines inside circle along with circle...")
  (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,CIRCLE"))))
  (while (not ss)
    (prompt "\nEmpty sel.set... Select lines inside circle along with circle again...")
    (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,CIRCLE"))))
  )
  (setq i -1)
  (setq sss (ssadd))
  (if ss
    (progn
      (while (setq curve (ssname ss (setq i (1+ i))))
        (setq m -1.0)
        (repeat (+ seg 1)
          (setq pt (vlax-curve-getpointatparam curve (+ (vlax-curve-getstartparam curve) (* (setq m (1+ m)) (/ (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve)) (float seg))))))
          (if (not (eq m seg))
            (setq ptlst (cons pt ptlst))
            (setq ptlst (cons (vlax-curve-getendpoint curve) ptlst))
          )
        )
        (setq ptlst (vl-remove nil ptlst))
        (setq pt (car ptlst))
        (if (vl-every '(lambda ( x ) (equal x pt fuzz)) ptlst)
          (entdel curve)
          (ssadd curve sss)
        )
        (setq ptlst nil)
      )
      (setq ii -1)
      (setq zz -1)
      (repeat (setq n (sslength sss))
        (setq ent (ssname sss (setq n (1- n))))
        (setq entl (cons ent entl))
      )
      (setq entl (vl-sort entl '(lambda ( a b ) (> (vlax-curve-getdistatparam a (vlax-curve-getendparam a)) (vlax-curve-getdistatparam b (vlax-curve-getendparam b))))))
      (setq sss (ssadd))
      (foreach ent entl
        (ssadd ent sss)
      )
      (if (/= (sslength sss) 0)
        (progn
          (while (setq curve (ssname sss (setq ii (1+ ii))))
            (foreach iii (vl-remove ii (if (null (nolst zz (if sss (1- (sslength sss)) zz))) (list ii) (nolst zz (if sss (1- (sslength sss)) zz))))
              (setq curvetst (ssname sss iii))
              (setq m -1.0)
              (repeat (+ seg 1)
                (setq pt (vlax-curve-getpointatparam curvetst (+ (vlax-curve-getstartparam curvetst) (* (setq m (1+ m)) (/ (- (vlax-curve-getendparam curvetst) (vlax-curve-getstartparam curvetst)) (float seg))))))
                (if (not (eq m seg))
                  (setq pttlst (cons pt pttlst))
                  (setq pttlst (cons (vlax-curve-getendpoint curve) pttlst))
                )
              )
              (foreach ptt pttlst
                (setq ptt (vlax-curve-getclosestpointto curve ptt))
                (setq ptlst (cons ptt ptlst))
              )
              (setq ptlst (reverse ptlst))
              (if (and
                    (vl-every '(lambda ( a b ) (equal a b fuzz)) ptlst pttlst)
                    (or
                      (if (setq pt (vlax-curve-getpointatparam curvetst (vlax-curve-getparamatpoint curvetst (vlax-curve-getclosestpointto curvetst (vlax-curve-getpointatparam curve (+ (vlax-curve-getstartparam curve) 1e-10)))))) ;; pt is either startpoint of curvetst or some point on curvetst
                        (if (not (equal (distance pt (vlax-curve-getstartpoint curve)) 0.0 fuzz))
                          ;; startpoint of curve is not equal to startpoint of curvetst
                          (if (setq pt (vlax-curve-getpointatparam curve (vlax-curve-getparamatpoint curve (vlax-curve-getclosestpointto curve (vlax-curve-getstartpoint curvetst))))) ;; pt is either startpoint of curve or some point on curve
                            (equal (distance pt (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curvetst "closely belongs" to curve and is not equal to startpoint of curve as it belongs to then statement of if function that checked that startpoint of curve is not equal to startpoint of curvetst
                          )
                          (or
                            (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to startpoint of curvetst
                            (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to endpoint of curvetst
                            (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to startpoint of curvetst
                            (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to endpoint of curvetst
                          ) ;; or checks coincidence of start/end points of curve and curvetst and for cases of reversed curves
                        )
                      )
                      (if (setq pt (vlax-curve-getpointatparam curvetst (vlax-curve-getparamatpoint curvetst (vlax-curve-getclosestpointto curvetst (vlax-curve-getpointatparam curve (- (vlax-curve-getendparam curve) 1e-10)))))) ;; pt is either endpoint of curvetst or some point on curvetst
                        (if (not (equal (distance pt (vlax-curve-getendpoint curvetst)) 0.0 fuzz))
                          ;; endpoint of curve is not equal to endpoint of curvetst
                          (if (setq pt (vlax-curve-getpointatparam curve (vlax-curve-getparamatpoint curve (vlax-curve-getclosestpointto curve (vlax-curve-getendpoint curvetst))))) ;; pt is either endpoint of curve or some point on curve
                            (equal (distance pt (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curvetst "closely belongs" to curve and is not equal to endpoint of curve as it belongs to then statement of if function that checked that endpoint of curve is not equal to endpoint of curvetst
                          )
                          (or
                            (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to startpoint of curvetst
                            (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to endpoint of curvetst
                            (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to startpoint of curvetst
                            (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to endpoint of curvetst
                          ) ;; or checks coincidence of start/end points of curve and curvetst and for cases of reversed curves
                        )
                      )
                    ) ;; curvetst is "inside" or equal to curve
                  )
                (if (not (member curve curves))
                  (setq curves (cons curvetst curves))
                )
              )
              (setq ptlst nil pttlst nil)
            )
          )
          (foreach curve curves
            (entdel curve)
          )
        )
      )
    )
  )
  (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (if (not (entget en)) (ssdel en ss))
  )
  (setq ssbb (acet-geom-ss-extents-accurate ss))
  (if (and (equal (caddr (car ssbb)) 0.0 1e-6) (equal (caddr (cadr ssbb)) 0.0 1e-6))
    (progn
      (setq ci (car (setq enl (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) '(lambda ( a b ) (> (eq (cdr (assoc 0 (entget a))) "CIRCLE") (eq (cdr (assoc 0 (entget b))) "CIRCLE")))))))
      (setq enl (cdr enl))
      (mapcar '(lambda ( e ) (if (eq (length (vlax-invoke (vlax-ename->vla-object ci) 'intersectwith (vlax-ename->vla-object e) acextendnone)) 6) (setq ml e))) enl)
      (if ml
        (progn
          (foreach l (vl-remove ml enl)
            (setq ip (inters (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l) (vlax-curve-getstartpoint ml) (vlax-curve-getendpoint ml) nil))
            (if (<
                  (distance (vlax-curve-getstartpoint l) (vlax-curve-getclosestpointto ml (vlax-curve-getstartpoint l)))
                  (distance (vlax-curve-getendpoint l) (vlax-curve-getclosestpointto ml (vlax-curve-getendpoint l)))
                )
                (putstart l ip)
                (putend l ip)
            )
          )
        )
        (progn
          (setq l1 (car enl) l2 (cadr enl))
          (setq ip (inters (vlax-curve-getstartpoint l1) (vlax-curve-getendpoint l1) (vlax-curve-getstartpoint l2) (vlax-curve-getendpoint l2) nil))
          (cond
            ( (and
                (< (distance ip (vlax-curve-getstartpoint l1)) (distance ip (vlax-curve-getendpoint l1)))
                (< (distance ip (vlax-curve-getstartpoint l2)) (distance ip (vlax-curve-getendpoint l2)))
              )
              (putstart l1 ip)
              (putstart l2 ip)
            )
            ( (and
                (< (distance ip (vlax-curve-getendpoint l1)) (distance ip (vlax-curve-getstartpoint l1)))
                (< (distance ip (vlax-curve-getstartpoint l2)) (distance ip (vlax-curve-getendpoint l2)))
              )
              (putend l1 ip)
              (putstart l2 ip)
            )
            ( (and
                (< (distance ip (vlax-curve-getstartpoint l1)) (distance ip (vlax-curve-getendpoint l1)))
                (< (distance ip (vlax-curve-getendpoint l2)) (distance ip (vlax-curve-getstartpoint l2)))
              )
              (putstart l1 ip)
              (putend l2 ip)
            )
            ( (and
                (< (distance ip (vlax-curve-getendpoint l1)) (distance ip (vlax-curve-getstartpoint l1)))
                (< (distance ip (vlax-curve-getendpoint l2)) (distance ip (vlax-curve-getstartpoint l2)))
              )
              (putend l1 ip)
              (putend l2 ip)
            )
          )
        )
      )
    )
    (progn
      (prompt "\nSome of selected entities have Z extents value different than 0.0... Quitting...")
      (exit)
    )
  )
  (*error* nil)
  (c:extlinsinscircles)
)

HTH, M.R.

[AIberto]

Did you from Mjtd.com dussla

Maybe something like this :

HTH, M.R.

I think the circle is a Mark .

[dussla]

ribarm thank you  and other friends


ribarm :  really thank you   
            code is work well , but  i would like to  select  multi circles  only ,   after that    extend line
          is that possible ?

yes  circel is mark

alberto :  no , i  don;t know  mtdy.com   well ~~

[ribarm]

Ok dussla, try this mod :

Code: [Select]

(defun c:extlinsinscircles ( / ss adoc *error* extlinsinscircle ss ssbb minpt maxpt s lay )

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))

  (defun *error* ( msg )
    (vla-endundomark adoc)
    (if msg (prompt msg))
    (princ)
  )

  (defun extlinsinscircle ( ss / nolst putstart putend seg fuzz i sss curve m pt ptlst ii zz n ent entl curvetst curves pttlst ssbb ci enl ml ip l1 l2 )

    (vl-load-com)

    (defun nolst ( st en / lst )
      (repeat (- en st)
        (setq st (1+ st))
        (setq lst (cons st lst))
      )
      (reverse lst)
    )

    (defun putstart ( ent pt / vtx )
      (cond
        ( (eq (cdr (assoc 0 (entget ent))) "LINE")
          (vla-put-startpoint (vlax-ename->vla-object ent) (vlax-3d-point pt))
        )
        ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 (mapcar '+ '(0.0 0.0) pt)) (assoc 10 (entget ent)) (entget ent))))))
        )
        ( (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
          (setq vtx (entnext ent))
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 pt) (assoc 10 (entget vtx)) (entget vtx))))))
          (entupd ent)
        )
      )
    )

    (defun putend ( ent pt / vtx )
      (cond
        ( (eq (cdr (assoc 0 (entget ent))) "LINE")
          (vla-put-endpoint (vlax-ename->vla-object ent) (vlax-3d-point pt))
        )
        ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 (mapcar '+ '(0.0 0.0) pt)) (assoc 10 (reverse (entget ent))) (entget ent))))))
        )
        ( (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
          (setq vtx (entnext ent))
          (while (/= (cdr (assoc 0 (entget (entnext (setq vtx (entnext vtx)))))) "SEQEND"))
          (entupd (cdr (assoc -1 (entmod (subst (cons 10 pt) (assoc 10 (entget vtx)) (entget vtx))))))
          (entupd ent)
        )
      )
    )

    (setq seg 100 fuzz 1e-4)
    (setq i -1)
    (setq sss (ssadd))
    (if ss
      (progn
        (while (setq curve (ssname ss (setq i (1+ i))))
          (setq m -1.0)
          (repeat (+ seg 1)
            (setq pt (vlax-curve-getpointatparam curve (+ (vlax-curve-getstartparam curve) (* (setq m (1+ m)) (/ (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve)) (float seg))))))
            (if (not (eq m seg))
              (setq ptlst (cons pt ptlst))
              (setq ptlst (cons (vlax-curve-getendpoint curve) ptlst))
            )
          )
          (setq ptlst (vl-remove nil ptlst))
          (setq pt (car ptlst))
          (if (vl-every '(lambda ( x ) (equal x pt fuzz)) ptlst)
            (entdel curve)
            (ssadd curve sss)
          )
          (setq ptlst nil)
        )
        (setq ii -1)
        (setq zz -1)
        (repeat (setq n (sslength sss))
          (setq ent (ssname sss (setq n (1- n))))
          (setq entl (cons ent entl))
        )
        (setq entl (vl-sort entl '(lambda ( a b ) (> (vlax-curve-getdistatparam a (vlax-curve-getendparam a)) (vlax-curve-getdistatparam b (vlax-curve-getendparam b))))))
        (setq sss (ssadd))
        (foreach ent entl
          (ssadd ent sss)
        )
        (if (/= (sslength sss) 0)
          (progn
            (while (setq curve (ssname sss (setq ii (1+ ii))))
              (foreach iii (vl-remove ii (if (null (nolst zz (if sss (1- (sslength sss)) zz))) (list ii) (nolst zz (if sss (1- (sslength sss)) zz))))
                (setq curvetst (ssname sss iii))
                (setq m -1.0)
                (repeat (+ seg 1)
                  (setq pt (vlax-curve-getpointatparam curvetst (+ (vlax-curve-getstartparam curvetst) (* (setq m (1+ m)) (/ (- (vlax-curve-getendparam curvetst) (vlax-curve-getstartparam curvetst)) (float seg))))))
                  (if (not (eq m seg))
                    (setq pttlst (cons pt pttlst))
                    (setq pttlst (cons (vlax-curve-getendpoint curve) pttlst))
                  )
                )
                (foreach ptt pttlst
                  (setq ptt (vlax-curve-getclosestpointto curve ptt))
                  (setq ptlst (cons ptt ptlst))
                )
                (setq ptlst (reverse ptlst))
                (if (and
                      (vl-every '(lambda ( a b ) (equal a b fuzz)) ptlst pttlst)
                      (or
                        (if (setq pt (vlax-curve-getpointatparam curvetst (vlax-curve-getparamatpoint curvetst (vlax-curve-getclosestpointto curvetst (vlax-curve-getpointatparam curve (+ (vlax-curve-getstartparam curve) 1e-10)))))) ;; pt is either startpoint of curvetst or some point on curvetst
                          (if (not (equal (distance pt (vlax-curve-getstartpoint curve)) 0.0 fuzz))
                          ;; startpoint of curve is not equal to startpoint of curvetst
                            (if (setq pt (vlax-curve-getpointatparam curve (vlax-curve-getparamatpoint curve (vlax-curve-getclosestpointto curve (vlax-curve-getstartpoint curvetst))))) ;; pt is either startpoint of curve or some point on curve
                              (equal (distance pt (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curvetst "closely belongs" to curve and is not equal to startpoint of curve as it belongs to then statement of if function that checked that startpoint of curve is not equal to startpoint of curvetst
                            )
                            (or
                              (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to startpoint of curvetst
                              (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to endpoint of curvetst
                              (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to startpoint of curvetst
                              (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to endpoint of curvetst
                            ) ;; or checks coincidence of start/end points of curve and curvetst and for cases of reversed curves
                          )
                        )
                        (if (setq pt (vlax-curve-getpointatparam curvetst (vlax-curve-getparamatpoint curvetst (vlax-curve-getclosestpointto curvetst (vlax-curve-getpointatparam curve (- (vlax-curve-getendparam curve) 1e-10)))))) ;; pt is either endpoint of curvetst or some point on curvetst
                          (if (not (equal (distance pt (vlax-curve-getendpoint curvetst)) 0.0 fuzz))
                          ;; endpoint of curve is not equal to endpoint of curvetst
                            (if (setq pt (vlax-curve-getpointatparam curve (vlax-curve-getparamatpoint curve (vlax-curve-getclosestpointto curve (vlax-curve-getendpoint curvetst))))) ;; pt is either endpoint of curve or some point on curve
                              (equal (distance pt (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curvetst "closely belongs" to curve and is not equal to endpoint of curve as it belongs to then statement of if function that checked that endpoint of curve is not equal to endpoint of curvetst
                            )
                            (or
                              (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to startpoint of curvetst
                              (equal (distance (vlax-curve-getstartpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; startpoint of curve is equal to endpoint of curvetst
                              (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getstartpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to startpoint of curvetst
                              (equal (distance (vlax-curve-getendpoint curve) (vlax-curve-getendpoint curvetst)) 0.0 fuzz) ;; endpoint of curve is equal to endpoint of curvetst
                            ) ;; or checks coincidence of start/end points of curve and curvetst and for cases of reversed curves
                          )
                        )
                      ) ;; curvetst is "inside" or equal to curve
                    )
                  (if (not (member curve curves))
                    (setq curves (cons curvetst curves))
                  )
                )
                (setq ptlst nil pttlst nil)
              )
            )
            (foreach curve curves
              (entdel curve)
            )
          )
        )
      )
    )
    (foreach en (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (if (not (entget en)) (ssdel en ss))
    )
    (setq ssbb (acet-geom-ss-extents-accurate ss))
    (if (and (equal (caddr (car ssbb)) 0.0 1e-6) (equal (caddr (cadr ssbb)) 0.0 1e-6))
      (progn
        (setq ci (car (setq enl (vl-sort (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) '(lambda ( a b ) (> (eq (cdr (assoc 0 (entget a))) "CIRCLE") (eq (cdr (assoc 0 (entget b))) "CIRCLE")))))))
        (setq enl (cdr enl))
        (mapcar '(lambda ( e ) (if (eq (length (vlax-invoke (vlax-ename->vla-object ci) 'intersectwith (vlax-ename->vla-object e) acextendnone)) 6) (setq ml e))) enl)
        (if ml
          (progn
            (foreach l (vl-remove ml enl)
              (setq ip (inters (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l) (vlax-curve-getstartpoint ml) (vlax-curve-getendpoint ml) nil))
              (if (<
                    (distance (vlax-curve-getstartpoint l) (vlax-curve-getclosestpointto ml (vlax-curve-getstartpoint l)))
                    (distance (vlax-curve-getendpoint l) (vlax-curve-getclosestpointto ml (vlax-curve-getendpoint l)))
                  )
                  (putstart l ip)
                  (putend l ip)
              )
            )
          )
          (progn
            (setq l1 (car enl) l2 (cadr enl))
            (setq ip (inters (vlax-curve-getstartpoint l1) (vlax-curve-getendpoint l1) (vlax-curve-getstartpoint l2) (vlax-curve-getendpoint l2) nil))
            (cond
              ( (and
                  (< (distance ip (vlax-curve-getstartpoint l1)) (distance ip (vlax-curve-getendpoint l1)))
                  (< (distance ip (vlax-curve-getstartpoint l2)) (distance ip (vlax-curve-getendpoint l2)))
                )
                (putstart l1 ip)
                (putstart l2 ip)
              )
              ( (and
                  (< (distance ip (vlax-curve-getendpoint l1)) (distance ip (vlax-curve-getstartpoint l1)))
                  (< (distance ip (vlax-curve-getstartpoint l2)) (distance ip (vlax-curve-getendpoint l2)))
                )
                (putend l1 ip)
                (putstart l2 ip)
              )
              ( (and
                  (< (distance ip (vlax-curve-getstartpoint l1)) (distance ip (vlax-curve-getendpoint l1)))
                  (< (distance ip (vlax-curve-getendpoint l2)) (distance ip (vlax-curve-getstartpoint l2)))
                )
                (putstart l1 ip)
                (putend l2 ip)
              )
              ( (and
                  (< (distance ip (vlax-curve-getendpoint l1)) (distance ip (vlax-curve-getstartpoint l1)))
                  (< (distance ip (vlax-curve-getendpoint l2)) (distance ip (vlax-curve-getstartpoint l2)))
                )
                (putend l1 ip)
                (putend l2 ip)
              )
            )
          )
        )
      )
      (progn
        (prompt "\nSome of selected entities have Z extents value different than 0.0... Quitting...")
        (exit)
      )
    )
  ) 

  (command "_.UCS" "_W")
  (vla-startundomark adoc)
  (prompt "\nSelect circles...")
  (setq ss (ssget '((0 . "CIRCLE"))))
  (while (not ss)
    (prompt "\nEmpty sel.set... Select circles again...")
    (setq ss (ssget '((0 . "CIRCLE"))))
  )
  (setq ssbb (acet-geom-ss-extents-accurate ss))
  (if (and
        (equal (caddr (car ssbb)) 0.0 1e-6)
        (equal (caddr (cadr ssbb)) 0.0 1e-6)
      )
      (progn
        (command "_.ZOOM" "_non" (car ssbb) "_non" (cadr ssbb))
        (foreach ci (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
          (vla-getboundingbox (vlax-ename->vla-object ci) 'minpt 'maxpt)
          (setq minpt (vlax-safearray->list minpt) maxpt (vlax-safearray->list maxpt))
          (setq s (ssget "_CP" (list (list (car minpt) (cadr minpt)) (list (car maxpt) (cadr minpt)) (list (car maxpt) (cadr maxpt)) (list (car minpt) (cadr maxpt))) '((0 . "*POLYLINE,LINE,CIRCLE"))))
          (vlax-for e (vla-get-activeselectionset adoc)
            (if (eq (vla-get-lock (vla-item (vla-get-layers adoc) (vla-get-layer e))) :vlax-true)
              (progn
                (setq lay (cons (vla-item (vla-get-layers adoc) (vla-get-layer e)) lay))
                (vla-put-lock (vla-item (vla-get-layers adoc) (vla-get-layer e)) :vlax-false)
              )
            )
          )
          (extlinsinscircle s)
          (foreach l lay
            (vla-put-lock l :vlax-true)
          )
        )
        (command "_.ZOOM" "_P")
      )
      (progn
        (prompt "\nSome of selected circles have Z extents value different than 0.0... Quitting...")
        (exit)
      )
  )
  (command "_.UCS" "_P")
  (*error* nil)
)


[ribarm]

Found some lacks in OVERKILL-MR sub placed inside posted code...

M.R.