alternative of _BOUNDARY in the mode of pick point

АлексЮстасу · ‎12-02-2015

I search an alternative to the command _BOUNDARY in the mode of pick point, for finding out minimum contours from intersecting elements (polylines, 3D polylines, lines, circles, ellipses, arcs, splines, multilines, regions):
1. not depending on the sizes of elements on the screen;
2. not depending on that, whether all possible elements of border are visible on the screen;
3. not thinking very long or infinitely;
4. not simplifying the found contours.

I found one variant - program BNDR only, but she does not develop, and actually inaccessible.
I made video. At first it is shown how BNDR works, and then _BOUNDARY.

https://youtu.be/aG01-R1nrQE - for model example.
https://youtu.be/iBE86OtIOog - for real data.

I hope that is other alternatives of BOUNDARY, that can be developed.

-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

marko_ribar · ‎02-27-2016

I have a little request/qestion :

Where can we get BNDR plugin for ACAD shown in your examples and is it free?

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

АлексЮстасу · ‎02-27-2016

I search an alternative to the command _BOUNDARY in the mode of pick point.
In my opinion, the solution of this task in AutoCAD is unsatisfactory.
BNDR - an example of the fact that the complete decision is possible. ObjectARX.

Unfortunately I didn't manage so far neither to buy the BNDR codes, nor to agree with the author about finishing.

-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

АлексЮстасу · ‎02-27-2016

Do you have any suggestions, do you know of any other solutions?

-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

marko_ribar · ‎02-27-2016

No I am afraid that I don't have any other solution... Actually seeing those videos you posted I realized that my work based on command -BOUNDARY is maybe cumbersome, so I thought I should at least bring this to attention... I had to revive this topic, it was already been forgotten... Now it's at least at the top of messages so maybe someone will look it and maybe found some atlternative...

Thanks for your initial post and take care,

regards, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

АлексЮстасу · ‎02-28-2016

Yes, thanks for support of a question!

BOUNDARY exists years 15, probably.
I try to find alternative of years 5-6.
Almost all programmers say to me that it very much, very much, very complex challenge.
One programmer of it didn't know, and quickly wrote - BNDR. And wrote in passing - as auxiliary for other task. 🙂

But it is impossible to use it actually.
One more programmer promises to write, but won't begin in any way.

So the task is actually not solved. Directly "Fermat's theorem"!

By the way, almost all "clones" solve the problem BOUNDARY easily!

And it is especially interesting what thinks of this Autodesk...

-- Alexander, private person, pacifist, english only with translator 🙂 --

Object-modeling _ odclass-odedit.com _ Help

marko_ribar · ‎06-05-2016

Alex, I don't think BOUNDARY command was written using Vanilla/Visual Lisp only... I made some attempts in LISP and although it's poor implementation, I'll post it here in ALISP forum... I am also interested to see if someone will reply and have some opinion... My method is using RAY entity and I don't think that was used in real BOUNDARY algorithm... And yes it's not good at all, but with some simple case it may solve, but only in simple situation with some ordinary entities surrounding picked internal point... What to say - I realized that I can't do it easy so you're right it's challenge for some more advanced programming...

(defun c:bndr ( / *error* unit *adoc* pea pck ss p i1 c1 i2 c2 ip ipl trl s el sx ii pl tt ttt trr trx trxx )

  (vl-load-com)

  (defun *error* ( m )
    (if pea
      (setvar 'peditaccept pea)
    )
    (if pck
      (setvar 'pickbox pck)
    )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun unit ( v )
    (if (not (equal v '(0.0 0.0 0.0) 1e-6))
      (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    )
  )

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (setq pck (getvar 'pickbox))
  (prompt "\nSelect boundary curve entities...")
  (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  (while (not ss)
    (prompt "\nSource curve boundary sel. set empty... Please reselect boundary curves on unlocked layer(s) again...")
    (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  )
  (initget 1)
  (setq p (getpoint "\nPick or specify internal point : "))
  (setvar 'pickbox 4)
  (repeat (setq i1 (sslength ss))
    (setq c1 (ssname ss (setq i1 (1- i1))))
    (ssdel c1 ss)
    (repeat (setq i2 (sslength ss))
      (setq c2 (ssname ss (setq i2 (1- i2))))
      (setq ip (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object c2) acextendnone))
      (if ip
        (repeat (/ (length ip) 3)
          (setq ipl (cons (list (car ip) (cadr ip) (caddr ip)) ipl))
          (setq ip (cdddr ip))
        )
      )
    )
    (setq ipl (vl-sort ipl '(lambda ( a b ) (< (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)))))
    (mapcar
     '(lambda ( a b / ray ipp ippl v )
        (setq v (unit (mapcar '- (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) p)))
        (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 p) (cons 11 v))))
        (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c1) acextendnone))
        (repeat (setq i2 (sslength ss))
          (setq c2 (ssname ss (setq i2 (1- i2))))
          (setq ipp (append (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c2) acextendnone) ipp))
        )
        (if ipp
          (repeat (/ (length ipp) 3)
            (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
            (setq ipp (cdddr ipp))
          )
        )
        (if (vlax-curve-getparamatpoint c1 (car (setq ippl (vl-sort ippl '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))))
          (progn
            (if (not (vl-position (list a c1 b) trl))
              (setq trl (cons (list a c1 b) trl))
            )
            ;|
            (if (cadr ippl)
              (foreach ipp (cdr ippl)
                (setq pl (cons ipp pl))
              )
            )
            |;
          )
          (if
            (and
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (car ippl) (car ippl))) 0) a)
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (car ippl) (car ippl))) 0) b)
              (not (vl-position (list a (ssname (ssdel ray (ssget "_C" (car ippl) (car ippl))) 0) b) trl))
            )
            (setq trl (cons (list a (ssname (ssdel ray (ssget "_C" (car ippl) (car ippl))) 0) b) trl))
          )
        )
        (entdel ray)
      )
      ipl
      (cdr ipl)
    )
    (setq ipl nil)
    (ssadd c1 ss)
  )
  ;|
  (foreach p pl
    (vl-some '(lambda ( x ) (if (< (vlax-curve-getparamatpoint (cadr x) (car x)) (vlax-curve-getparamatpoint (cadr x) p) (vlax-curve-getparamatpoint (cadr x) (caddr x))) (setq tr x) (setq tr nil))) trl)
    (if tr
      (setq trl (vl-remove tr trl))
    )
    (setq tr nil)
  )
  |;

  ;|
  (foreach tr trl
    (setq trx (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl))
    (if (> (length trx) 1)
      (progn
        (foreach tt trx
          (setq trl (vl-remove tt trl))
        )
        (setq trr trx)
        (while (setq tt (car trx))
          (setq ttt (cadr trx))
          (if (equal (last tt) (car ttt) 1e-6)
            (setq trxx (cons (list (car tt) (cadr tt) (caddr ttt)) trxx))
          )
          (setq trx (cdr trx))
        )
        (setq trxx (reverse trxx))
        (setq trr (vl-remove-if '(lambda ( x ) (vl-some '(lambda ( y ) (or (equal (caddr y) (car x) 1e-6) (equal (car y) (caddr x) 1e-6))) trr)) trr))
        (foreach tt trxx
          (setq trr (cons tt trr))
        )
        (foreach tt trr
          (setq trl (cons tt trl))
        )
      )
    )
  )
  |;

  (foreach tr trl
    (repeat (1- (length (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl)))
      (setq trl (subst (list (car tr) (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (cadr tr)))) (caddr tr) t) tr trl))
    )
  )
  (foreach tr trl
    (if (eq (last tr) t)
      (entdel (cadr tr))
    )
  )
  (setq s (ssadd))
  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
    (cond
      ( (and
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (car tr) (car tr)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (car tr) (car tr)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (cadr tr))
    (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
    (cond
      ( (and
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (car tr) (car tr)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (car tr) (car tr)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  ;;; (command "_.JOIN" (ssname s 0) s "") - JOIN command variant looks better but CAD can't do it good...
  (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0)
  (while (< 0 (getvar 'cmdactive))
    (command "")
  )
  ;;; PEDIT JOIN command for generating LWPOLYLINE as result, more stupid version, but CAD can handle it better...  
  (command "_.COPYBASE" "_non" '(0.0 0.0 0.0) (if (not (vlax-erased-p (ssname s 0))) (ssname s 0) (entlast)) "")
  (command "_.UNDO" "_B")
  (command "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
  (sssetfirst nil (ssadd (entlast)))
  (*error* nil)
)

HTH, M.R.

Regards...

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-06-2016

Nothing special, just little more reliable with not crossing curves... I can't edit post so I am posting my little revision :

...
  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
    )
    (cond
      ( (and
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (car tr) (car tr)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (car tr) (car tr)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (cadr tr))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
    )
    (cond
      ( (and
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (car tr) (car tr)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (car tr) (car tr)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
...

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-06-2016

Not so important if you're in WCS, but here is revision for eralier part of routine... Forgot to place (trans p 1 0) where it was needed instead of just p...

...
    (mapcar
     '(lambda ( a b / ray ipp ippl v )
        (setq v (unit (mapcar '- (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (trans p 1 0))))
        (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans p 1 0)) (cons 11 v))))
        (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c1) acextendnone))
        (repeat (setq i2 (sslength ss))
          (setq c2 (ssname ss (setq i2 (1- i2))))
          (setq ipp (append (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c2) acextendnone) ipp))
        )
        (if ipp
          (repeat (/ (length ipp) 3)
            (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
            (setq ipp (cdddr ipp))
          )
        )
        (if (vlax-curve-getparamatpoint c1 (car (setq ippl (vl-sort ippl '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))))
          (progn
            (if (not (vl-position (list a c1 b) trl))
              (setq trl (cons (list a c1 b) trl))
            )
            ;|
            (if (cadr ippl)
              (foreach ipp (cdr ippl)
                (setq pl (cons ipp pl))
              )
            )
            |;
          )
          (if
            (and
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) a)
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b)
              (not (vl-position (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
            )
            (setq trl (cons (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
          )
        )
        (entdel ray)
      )
      ipl
      (cdr ipl)
    )
    (setq ipl nil)
    (ssadd c1 ss)
  )
  ;|
  (foreach p pl
    (vl-some '(lambda ( x ) (if (< (vlax-curve-getparamatpoint (cadr x) (car x)) (vlax-curve-getparamatpoint (cadr x) (trans p 1 0)) (vlax-curve-getparamatpoint (cadr x) (caddr x))) (setq tr x) (setq tr nil))) trl)
    (if tr
      (setq trl (vl-remove tr trl))
    )
    (setq tr nil)
  )
  |;
...

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-06-2016

Sorry again last part... Forgot (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))...

  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
    )
    (cond
      ( (and
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (cadr tr))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
    )
    (cond
      ( (and
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-06-2016

I've made few more changes, so now I'll post the code entirely...

(defun c:bndr ( / *error* unit *adoc* pea pck ss p i1 c1 i2 c2 ip ipl trl s el sx ii pl tt ttt trr trx trxx cx k )

  (vl-load-com)

  (defun *error* ( m )
    (if pea
      (setvar 'peditaccept pea)
    )
    (if pck
      (setvar 'pickbox pck)
    )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun unit ( v )
    (if (not (equal v '(0.0 0.0 0.0) 1e-6))
      (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    )
  )

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (setq pck (getvar 'pickbox))
  (prompt "\nSelect boundary curve entities...")
  (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  (while (not ss)
    (prompt "\nSource curve boundary sel. set empty... Please reselect boundary curves on unlocked layer(s) again...")
    (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  )
  (initget 1)
  (setq p (getpoint "\nPick or specify internal point : "))
  (setvar 'pickbox 4)
  (repeat (setq i1 (sslength ss))
    (setq c1 (ssname ss (setq i1 (1- i1))))
    (ssdel c1 ss)
    (repeat (setq i2 (sslength ss))
      (setq c2 (ssname ss (setq i2 (1- i2))))
      (setq ip (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object c2) acextendnone))
      (if ip
        (repeat (/ (length ip) 3)
          (setq ipl (cons (list (car ip) (cadr ip) (caddr ip)) ipl))
          (setq ip (cdddr ip))
        )
      )
    )
    (setq ipl (vl-sort ipl '(lambda ( a b ) (< (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)))))
    (mapcar
     '(lambda ( a b / ray ipp ippl v )
        (setq v (unit (mapcar '- (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (trans p 1 0))))
        (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans p 1 0)) (cons 11 v))))
        (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c1) acextendnone))
        (repeat (setq i2 (sslength ss))
          (setq c2 (ssname ss (setq i2 (1- i2))))
          (setq ipp (append (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c2) acextendnone) ipp))
        )
        (if ipp
          (repeat (/ (length ipp) 3)
            (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
            (setq ipp (cdddr ipp))
          )
        )
        (if (vlax-curve-getparamatpoint c1 (car (setq ippl (vl-sort ippl '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))))
          (progn
            (if (not (vl-position (list a c1 b) trl))
              (setq trl (cons (list a c1 b) trl))
            )
            ;|
            (if (cadr ippl)
              (foreach ipp (cdr ippl)
                (setq pl (cons ipp pl))
              )
            )
            |;
          )
          (if
            (and
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) a)
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b)
              (not (vl-position (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
            )
            (setq trl (cons (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
          )
        )
        (entdel ray)
      )
      ipl
      (cdr ipl)
    )
    (setq ipl nil)
    (ssadd c1 ss)
  )
  ;|
  (foreach p pl
    (vl-some '(lambda ( x ) (if (< (vlax-curve-getparamatpoint (cadr x) (car x)) (vlax-curve-getparamatpoint (cadr x) (trans p 1 0)) (vlax-curve-getparamatpoint (cadr x) (caddr x))) (setq tr x) (setq tr nil))) trl)
    (if tr
      (setq trl (vl-remove tr trl))
    )
    (setq tr nil)
  )
  |;

  ;|
  (foreach tr trl
    (setq trx (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl))
    (if (> (length trx) 1)
      (progn
        (foreach tt trx
          (setq trl (vl-remove tt trl))
        )
        (setq trr trx)
        (while (setq tt (car trx))
          (setq ttt (cadr trx))
          (if (equal (last tt) (car ttt) 1e-6)
            (setq trxx (cons (list (car tt) (cadr tt) (caddr ttt)) trxx))
          )
          (setq trx (cdr trx))
        )
        (setq trxx (reverse trxx))
        (setq trr (vl-remove-if '(lambda ( x ) (vl-some '(lambda ( y ) (or (equal (caddr y) (car x) 1e-6) (equal (car y) (caddr x) 1e-6))) trr)) trr))
        (foreach tt trxx
          (setq trr (cons tt trr))
        )
        (foreach tt trr
          (setq trl (cons tt trl))
        )
      )
    )
  )
  |;

  (foreach tr trl
    (repeat (1- (length (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl)))
      (setq trl (subst (list (car tr) (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (cadr tr)))) (caddr tr) t) tr trl))
    )
  )
  (foreach tr trl
    (if (eq (last tr) t)
      (entdel (cadr tr))
    )
  )
  (setq s (ssadd))
  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and
          (eq (cadr tr) (entlast))
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (progn
          (setq cx (entget (entlast)))
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
          (while (equal cx (entget (entlast)) 1e-6)
            (prompt "\nBug trimming...")
          )
        )
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (progn
          (setq cx (entget (cadr tr)))
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
          (while (equal cx (entget (cadr tr)) 1e-6)
            (prompt "\nBug trimming...")
          )
        )
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (cadr tr))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and
          (eq (cadr tr) (entlast))
          (vlax-curve-getparamatpoint (entlast) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (car tr) 1e-6)
            )
          )
        )
        (progn
          (setq cx (entget (entlast)))
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (< (vlax-curve-getparamatpoint (entlast) (caddr tr)) (vlax-curve-getparamatpoint (entlast) (car tr))) (vlax-curve-getendparam (entlast)) (vlax-curve-getstartparam (entlast))))) 0 1) "")
          (while (equal cx (entget (entlast)) 1e-6)
            (prompt "\nBug trimming...")
          )
        )
      )
      ( (and
          (vlax-curve-getparamatpoint (cadr tr) (caddr tr))
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
            )
          )
        )
        (progn
          (setq cx (entget (cadr tr)))
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (< (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (vlax-curve-getparamatpoint (cadr tr) (car tr))) (vlax-curve-getendparam (cadr tr)) (vlax-curve-getstartparam (cadr tr))))) 0 1) "")
          (while (equal cx (entget (cadr tr)) 1e-6)
            (prompt "\nBug trimming...")
          )
        )
      )
    )
    (if (not (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
      (progn
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
      (progn
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (if (vl-some '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "SPLINE,ELLIPSE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
    (command "_.JOIN" (ssname s 0) s "")
    (progn
      (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0)
      (while (< 0 (getvar 'cmdactive))
        (command "")
      )
    )
  )
  (command "_.COPYBASE" "_non" '(0.0 0.0 0.0) (if (not (vlax-erased-p (ssname s 0))) (ssname s 0) (entlast)) "")
  (command "_.UNDO" "_B")
  (command "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
  (sssetfirst nil (ssadd (entlast)))
  (*error* nil)
)

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-06-2016

Again, can't edit post... So even more modifications... Here is my latest version :

(defun c:bndr ( / *error* unit *adoc* pea pck ss p i1 c1 i2 c2 ip ipl trl s el sx ii pl tt ttt trr trx trxx cx k e i ray ipp ippl )

  (vl-load-com)

  (defun *error* ( m )
    (if pea
      (setvar 'peditaccept pea)
    )
    (if pck
      (setvar 'pickbox pck)
    )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun unit ( v )
    (if (not (equal v '(0.0 0.0 0.0) 1e-6))
      (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    )
  )

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (setq pck (getvar 'pickbox))
  (prompt "\nSelect boundary curve entities...")
  (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  (while (not ss)
    (prompt "\nSource curve boundary sel. set empty... Please reselect boundary curves on unlocked layer(s) again...")
    (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  )
  (initget 1)
  (setq p (getpoint "\nPick or specify internal point : "))
  (setvar 'pickbox 4)
  (repeat (setq i1 (sslength ss))
    (setq c1 (ssname ss (setq i1 (1- i1))))
    (ssdel c1 ss)
    (repeat (setq i2 (sslength ss))
      (setq c2 (ssname ss (setq i2 (1- i2))))
      (setq ip (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object c2) acextendnone))
      (if ip
        (repeat (/ (length ip) 3)
          (setq ipl (cons (list (car ip) (cadr ip) (caddr ip)) ipl))
          (setq ip (cdddr ip))
        )
      )
    )
    (setq ipl (vl-sort ipl '(lambda ( a b ) (< (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)))))
    (mapcar
     '(lambda ( a b / ray ipp ippl v )
        (setq v (unit (mapcar '- (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (trans p 1 0))))
        (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans p 1 0)) (cons 11 v))))
        (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c1) acextendnone))
        (repeat (setq i2 (sslength ss))
          (setq c2 (ssname ss (setq i2 (1- i2))))
          (setq ipp (append (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c2) acextendnone) ipp))
        )
        (if ipp
          (repeat (/ (length ipp) 3)
            (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
            (setq ipp (cdddr ipp))
          )
        )
        (if (vlax-curve-getparamatpoint c1 (car (setq ippl (vl-sort ippl '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))))
          (progn
            (if (not (vl-position (list a c1 b) trl))
              (setq trl (cons (list a c1 b) trl))
            )
            ;|
            (if (cadr ippl)
              (foreach ipp (cdr ippl)
                (setq pl (cons ipp pl))
              )
            )
            |;
          )
          (if
            (and
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) a)
              (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b)
              (not (vl-position (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
            )
            (setq trl (cons (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
          )
        )
        (entdel ray)
      )
      ipl
      (cdr ipl)
    )
    (setq ipl nil)
    (ssadd c1 ss)
  )
  ;|
  (foreach p pl
    (vl-some '(lambda ( x ) (if (< (vlax-curve-getparamatpoint (cadr x) (car x)) (vlax-curve-getparamatpoint (cadr x) (trans p 1 0)) (vlax-curve-getparamatpoint (cadr x) (caddr x))) (setq tr x) (setq tr nil))) trl)
    (if tr
      (setq trl (vl-remove tr trl))
    )
    (setq tr nil)
  )
  (foreach tr trl
    (setq trx (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl))
    (if (> (length trx) 1)
      (progn
        (foreach tt trx
          (setq trl (vl-remove tt trl))
        )
        (setq trr trx)
        (while (setq tt (car trx))
          (setq ttt (cadr trx))
          (if (equal (last tt) (car ttt) 1e-6)
            (setq trxx (cons (list (car tt) (cadr tt) (caddr ttt)) trxx))
          )
          (setq trx (cdr trx))
        )
        (setq trxx (reverse trxx))
        (setq trr (vl-remove-if '(lambda ( x ) (vl-some '(lambda ( y ) (or (equal (caddr y) (car x) 1e-6) (equal (car y) (caddr x) 1e-6))) trr)) trr))
        (foreach tt trxx
          (setq trr (cons tt trr))
        )
        (foreach tt trr
          (setq trl (cons tt trl))
        )
      )
    )
  )
  |;
  (foreach tr trl
    (repeat (1- (length (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl)))
      (setq trl (subst (list (car tr) (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (cadr tr)))) (caddr tr) t) tr trl))
    )
  )
  (foreach tr trl
    (if (eq (last tr) t)
      (entdel (cadr tr))
    )
  )
  (setq s (ssadd))
  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (if (vl-some '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "SPLINE,ELLIPSE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
    (command "_.JOIN" (ssname s 0) s "")
    (progn
      (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0)
      (while (< 0 (getvar 'cmdactive))
        (command "")
      )
    )
  )
  (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans p 1 0)) (cons 11 (getvar 'ucsxdir)))))
  (repeat (setq i (sslength (setq ss (ssget "_A"))))
    (setq e (ssname ss (setq i (1- i))))
    (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object e) acextendnone))
    (setq ippl (append ipp ippl))
  )
  (setq ipp nil)
  (repeat (/ (length ippl) 3)
    (setq ipp (cons (list (car ippl) (cadr ippl) (caddr ippl)) ipp))
    (setq ippl (cdddr ippl))
  )
  (setq ippl (vl-sort ipp '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (if (vlax-curve-getparamatpoint ent (car ippl))
      (setq e ent)
    )
  )
  (entdel ray)
  (command "_.COPYBASE" "_non" '(0.0 0.0 0.0) e "")
  (command "_.UNDO" "_B")
  (command "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
  (sssetfirst nil (ssadd (entlast)))
  (*error* nil)
)

HTH, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-07-2016

Latest version :

(defun c:bndr ( / *error* unit bbucs *adoc* pea pck ss p bb dx dy kx ky pp pl pll li i1 c1 i2 c2 ip ipl trl s el sx ii cx k e i ray ipp ippl )

  (vl-load-com)

  (defun *error* ( m )
    (if pea
      (setvar 'peditaccept pea)
    )
    (if pck
      (setvar 'pickbox pck)
    )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun unit ( v )
    (if (not (equal v '(0.0 0.0 0.0) 1e-6))
      (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    )
  )

  (defun bbucs ( ss / UCS2WCSMatrix WCS2UCSMatrix n ent minpt maxpt minptlst maxptlst minptbbx minptbby minptbbz minptbb maxptbbx maxptbby maxptbbz maxptbb )

    (vl-load-com)

    ;; Doug C. Broad, Jr.
    ;; can be used with vla-transformby to
    ;; transform objects from the UCS to the WCS
    (defun UCS2WCSMatrix ()
      (vlax-tmatrix
        (append
          (mapcar
           '(lambda (vector origin)
            (append (trans vector 1 0 t) (list origin))
          )
          (list '(1 0 0) '(0 1 0) '(0 0 1))
          (trans '(0 0 0) 0 1)
          )
          (list '(0 0 0 1))
        )
      )
    )
    ;; transform objects from the WCS to the UCS
    (defun WCS2UCSMatrix ()
      (vlax-tmatrix
        (append
          (mapcar
           '(lambda (vector origin)
            (append (trans vector 0 1 t) (list origin))
          )
          (list '(1 0 0) '(0 1 0) '(0 0 1))
          (trans '(0 0 0) 1 0)
          )
          (list '(0 0 0 1))
        )
      )
    )

    (if ss
      (progn
        (repeat (setq n (sslength ss))
          (setq ent (ssname ss (setq n (1- n))))
          (vla-TransformBy (vlax-ename->vla-object ent) (UCS2WCSMatrix))
          (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
          (vla-TransformBy (vlax-ename->vla-object ent) (WCS2UCSMatrix))
          (setq minpt (vlax-safearray->list minpoint))
          (setq maxpt (vlax-safearray->list maxpoint))
          (setq minptlst (cons minpt minptlst))
          (setq maxptlst (cons maxpt maxptlst))
        )
        (setq minptbbx (caar (vl-sort minptlst '(lambda (a b) (< (car a) (car b))))))
        (setq minptbby (cadar (vl-sort minptlst '(lambda (a b) (< (cadr a) (cadr b))))))
        (setq minptbbz (caddar (vl-sort minptlst '(lambda (a b) (< (caddr a) (caddr b))))))
        (setq maxptbbx (caar (vl-sort maxptlst '(lambda (a b) (> (car a) (car b))))))
        (setq maxptbby (cadar (vl-sort maxptlst '(lambda (a b) (> (cadr a) (cadr b))))))
        (setq maxptbbz (caddar (vl-sort maxptlst '(lambda (a b) (> (caddr a) (caddr b))))))
        (setq minptbb (list minptbbx minptbby minptbbz))
        (setq maxptbb (list maxptbbx maxptbby maxptbbz))
      )
    )
    (list minptbb maxptbb)
  )

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (setq pck (getvar 'pickbox))
  (prompt "\nSelect boundary curve entities...")
  (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  (while (not ss)
    (prompt "\nSource curve boundary sel. set empty... Please reselect boundary curves on unlocked layer(s) again...")
    (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  )
  (initget 1)
  (setq p (getpoint "\nPick or specify internal point : "))
  (setvar 'pickbox 4)
  (setq bb (bbucs ss))
  (setq dx (/ (abs (- (car (cadr bb)) (car (car bb)))) 20.0))
  (setq dy (/ (abs (- (cadr (cadr bb)) (cadr (car bb)))) 20.0))
  (setq ky 0)
  (repeat 19
    (setq ky (1+ ky))
    (setq kx 0)
    (repeat 19
      (setq kx (1+ kx))
      (setq pp (list (+ (car (car bb)) (* kx dx)) (+ (cadr (car bb)) (* ky dy)) 0.0))
      (setq pl (cons pp pl))
    )
  )
  (foreach pp pl
    (setq li (entmakex (list '(0 . "LINE") (cons 10 (trans p 1 0)) (cons 11 (trans pp 1 0)))))
    (setq ippl nil)
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i))))
      (setq ipp (vlax-invoke (vlax-ename->vla-object li) 'intersectwith (vlax-ename->vla-object e) acextendnone))
      (setq ippl (append ipp ippl))
    )
    (if (or (null ippl) (= 0 (rem (length ippl) 6)))
      (setq pll (cons pp pll))
    )
    (entdel li)
  )
  (setq pll (vl-remove-if-not '(lambda ( x ) (< (distance p x) (* 2.0 (min dx dy)))) pll))
  ;|
  (foreach pp pll
    (entmake (list '(0 . "POINT") (cons 10 (trans pp 1 0))))
  )
  |;
  (repeat (setq i1 (sslength ss))
    (setq c1 (ssname ss (setq i1 (1- i1))))
    (ssdel c1 ss)
    (repeat (setq i2 (sslength ss))
      (setq c2 (ssname ss (setq i2 (1- i2))))
      (setq ip (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object c2) acextendnone))
      (if ip
        (repeat (/ (length ip) 3)
          (setq ipl (cons (list (car ip) (cadr ip) (caddr ip)) ipl))
          (setq ip (cdddr ip))
        )
      )
    )
    (setq ipl (vl-sort ipl '(lambda ( a b ) (< (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)))))
    (mapcar
     '(lambda ( a b / f ray ipp ippl v )
        (foreach pp pll
          (setq ippl nil)
          (setq v (unit (mapcar '- (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (trans pp 1 0))))
          (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans pp 1 0)) (cons 11 v))))
          (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c1) acextendnone))
          (repeat (setq i2 (sslength ss))
            (setq c2 (ssname ss (setq i2 (1- i2))))
            (setq ipp (append (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c2) acextendnone) ipp))
          )
          (if ipp
            (repeat (/ (length ipp) 3)
              (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
              (setq ipp (cdddr ipp))
            )
          )
          (if (vlax-curve-getparamatpoint c1 (car (setq ippl (vl-sort ippl '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))))
            (progn
              (if (not (vl-position (list a c1 b) trl))
                (setq trl (cons (list a c1 b) trl))
              )
              (setq f (cons t f))
            )
            ;|
            (if
              (and
                (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) a)
                (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b)
                (not (vl-position (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
              )
              (setq trl (cons (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
            )
            |;
            (setq f (cons nil f))
          )
          (entdel ray)
        )
        (if (and (eval (cons 'or f)) (null (eval (cons 'and f))))
          (setq trl (cdr trl))
        )
      )
      ipl
      (cdr ipl)
    )
    (setq ipl nil)
    (ssadd c1 ss)
  )
  (foreach tr trl
    (repeat (1- (length (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl)))
      (setq trl (subst (list (car tr) (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (cadr tr)))) (caddr tr) t) tr trl))
    )
  )
  (foreach tr trl
    (if (eq (last tr) t)
      (entdel (cadr tr))
    )
  )
  (setq s (ssadd))
  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (if (vl-some '(lambda ( x ) (if (wcmatch (cdr (assoc 0 (entget x))) "SPLINE,ELLIPSE") (setq e x))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
    (command "_.JOIN" e s "")
    (progn
      (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0)
      (while (< 0 (getvar 'cmdactive))
        (command "")
      )
    )
  )
  (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans p 1 0)) (cons 11 (getvar 'ucsxdir)))))
  (setq ss (ssget "_A"))
  (ssdel ray ss)
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
    (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object e) acextendnone))
    (setq ippl (append ipp ippl))
  )
  (setq ipp nil)
  (repeat (/ (length ippl) 3)
    (setq ipp (cons (list (car ippl) (cadr ippl) (caddr ippl)) ipp))
    (setq ippl (cdddr ippl))
  )
  (setq ippl (vl-sort ipp '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (if (vlax-curve-getparamatpoint ent (car ippl))
      (setq e ent)
    )
  )
  (entdel ray)
  (command "_.COPYBASE" "_non" '(0.0 0.0 0.0) e "")
  (command "_.UNDO" "_B")
  (command "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
  (sssetfirst nil (ssadd (entlast)))
  (*error* nil)
)

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-07-2016

Latest imprvement...

(defun c:bndr ( / *error* unit bbucs *adoc* pea pck ss p bb dx dy kx ky pp ipp1 ipp2 ippl1 ippl2 rec pl pll li1 li2 i1 c1 i2 c2 ip ipl trl s el sx ii cx k e i ray ipp ippl )

  (vl-load-com)

  (defun *error* ( m )
    (if pea
      (setvar 'peditaccept pea)
    )
    (if pck
      (setvar 'pickbox pck)
    )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun unit ( v )
    (if (not (equal v '(0.0 0.0 0.0) 1e-6))
      (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    )
  )

  (defun bbucs ( ss / UCS2WCSMatrix WCS2UCSMatrix n ent minpt maxpt minptlst maxptlst minptbbx minptbby minptbbz minptbb maxptbbx maxptbby maxptbbz maxptbb )

    (vl-load-com)

    ;; Doug C. Broad, Jr.
    ;; can be used with vla-transformby to
    ;; transform objects from the UCS to the WCS
    (defun UCS2WCSMatrix ()
      (vlax-tmatrix
        (append
          (mapcar
           '(lambda (vector origin)
            (append (trans vector 1 0 t) (list origin))
          )
          (list '(1 0 0) '(0 1 0) '(0 0 1))
          (trans '(0 0 0) 0 1)
          )
          (list '(0 0 0 1))
        )
      )
    )
    ;; transform objects from the WCS to the UCS
    (defun WCS2UCSMatrix ()
      (vlax-tmatrix
        (append
          (mapcar
           '(lambda (vector origin)
            (append (trans vector 0 1 t) (list origin))
          )
          (list '(1 0 0) '(0 1 0) '(0 0 1))
          (trans '(0 0 0) 1 0)
          )
          (list '(0 0 0 1))
        )
      )
    )

    (if ss
      (progn
        (repeat (setq n (sslength ss))
          (setq ent (ssname ss (setq n (1- n))))
          (vla-TransformBy (vlax-ename->vla-object ent) (UCS2WCSMatrix))
          (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
          (vla-TransformBy (vlax-ename->vla-object ent) (WCS2UCSMatrix))
          (setq minpt (vlax-safearray->list minpoint))
          (setq maxpt (vlax-safearray->list maxpoint))
          (setq minptlst (cons minpt minptlst))
          (setq maxptlst (cons maxpt maxptlst))
        )
        (setq minptbbx (caar (vl-sort minptlst '(lambda (a b) (< (car a) (car b))))))
        (setq minptbby (cadar (vl-sort minptlst '(lambda (a b) (< (cadr a) (cadr b))))))
        (setq minptbbz (caddar (vl-sort minptlst '(lambda (a b) (< (caddr a) (caddr b))))))
        (setq maxptbbx (caar (vl-sort maxptlst '(lambda (a b) (> (car a) (car b))))))
        (setq maxptbby (cadar (vl-sort maxptlst '(lambda (a b) (> (cadr a) (cadr b))))))
        (setq maxptbbz (caddar (vl-sort maxptlst '(lambda (a b) (> (caddr a) (caddr b))))))
        (setq minptbb (list minptbbx minptbby minptbbz))
        (setq maxptbb (list maxptbbx maxptbby maxptbbz))
      )
    )
    (list minptbb maxptbb)
  )

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (setq pck (getvar 'pickbox))
  (prompt "\nSelect boundary curve entities...")
  (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  (while (not ss)
    (prompt "\nSource curve boundary sel. set empty... Please reselect boundary curves on unlocked layer(s) again...")
    (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  )
  (initget 1)
  (setq p (getpoint "\nPick or specify internal point : "))
  (setvar 'pickbox 1)
  (setq bb (bbucs ss))
  (setq dx (/ (abs (- (car (cadr bb)) (car (car bb)))) 10.0))
  (setq dy (/ (abs (- (cadr (cadr bb)) (cadr (car bb)))) 10.0))
  (setq ky 0)
  (repeat 9
    (setq ky (1+ ky))
    (setq kx 0)
    (repeat 9
      (setq kx (1+ kx))
      (setq pp (list (+ (car (car bb)) (* kx dx)) (+ (cadr (car bb)) (* ky dy)) 0.0))
      (setq pl (cons pp pl))
    )
  )
  (setq rec
    (entmakex
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)
        '(70 . 1)
        (cons 38 (caddr (trans (car bb) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (car bb))
        (cons 10 (list (car (cadr bb)) (cadr (car bb))))
        (cons 10 (cadr bb))
        (cons 10 (list (car (car bb)) (cadr (cadr bb))))
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )
  (foreach pp pl
    (setq li1 (entmakex (list '(0 . "LINE") (cons 10 (trans p 1 0)) (cons 11 (trans pp 1 0)))))
    (setq li2 (entmakex (list '(0 . "LINE") (cons 10 (trans pp 1 0)) (cons 11 (vlax-curve-getclosestpointto rec (trans pp 1 0))))))
    (setq ippl1 nil ippl2 nil)
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i))))
      (setq ipp1 (vlax-invoke (vlax-ename->vla-object li1) 'intersectwith (vlax-ename->vla-object e) acextendnone))
      (setq ippl1 (append ipp1 ippl1))
      (setq ipp2 (vlax-invoke (vlax-ename->vla-object li2) 'intersectwith (vlax-ename->vla-object e) acextendnone))
      (setq ippl2 (append ipp2 ippl2))
    )
    (if (and (or (null ippl1) (= 0 (rem (length ippl1) 6))) (not (null ippl2)))
      (setq pll (cons pp pll))
    )
    (entdel li1)
    (entdel li2)
  )
  (entdel rec)
  ;|
  (foreach pp pll
    (entmake (list '(0 . "POINT") (cons 10 (trans pp 1 0))))
  )
  |;
  (setq pll (vl-remove-if-not '(lambda ( x ) (< (distance p x) (* 3.0 (min dx dy)))) pll))
  (repeat (setq i1 (sslength ss))
    (setq c1 (ssname ss (setq i1 (1- i1))))
    (ssdel c1 ss)
    (repeat (setq i2 (sslength ss))
      (setq c2 (ssname ss (setq i2 (1- i2))))
      (setq ip (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object c2) acextendnone))
      (if ip
        (repeat (/ (length ip) 3)
          (setq ipl (cons (list (car ip) (cadr ip) (caddr ip)) ipl))
          (setq ip (cdddr ip))
        )
      )
    )
    (setq ipl (vl-sort ipl '(lambda ( a b ) (< (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)))))
    (mapcar
     '(lambda ( a b / ray ipp ippl v )
        (foreach pp pll
          (setq ippl nil)
          (setq v (unit (mapcar '- (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (trans pp 1 0))))
          (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans pp 1 0)) (cons 11 v))))
          (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c1) acextendnone))
          (repeat (setq i2 (sslength ss))
            (setq c2 (ssname ss (setq i2 (1- i2))))
            (setq ipp (append (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c2) acextendnone) ipp))
          )
          (if ipp
            (repeat (/ (length ipp) 3)
              (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
              (setq ipp (cdddr ipp))
            )
          )
          (if (equal (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (car (setq ippl (vl-sort ippl '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))) 1e-6)
            (if (not (vl-position (list a c1 b) trl))
              (setq trl (cons (list a c1 b) trl))
            )
            (if
              (and
                (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) a)
                (vlax-curve-getparamatpoint (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b)
                (not (vl-position (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
              )
              (setq trl (cons (list a (ssname (ssdel ray (ssget "_C" (trans (car ippl) 0 1) (trans (car ippl) 0 1))) 0) b) trl))
            )
          )
          (entdel ray)
        )
      )
      ipl
      (cdr ipl)
    )
    (setq ipl nil)
    (ssadd c1 ss)
  )
  (foreach tr trl
    (repeat (1- (length (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl)))
      (setq trl (subst (list (car tr) (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (cadr tr)))) (caddr tr) t) tr trl))
    )
  )
  (foreach tr trl
    (if (eq (last tr) t)
      (entdel (cadr tr))
    )
  )
  (setq s (ssadd))
  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (if (vl-some '(lambda ( x ) (if (wcmatch (cdr (assoc 0 (entget x))) "SPLINE,ELLIPSE") (setq e x))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
    (command "_.JOIN" e s "")
    (progn
      (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0)
      (while (< 0 (getvar 'cmdactive))
        (command "")
      )
    )
  )
  (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans p 1 0)) (cons 11 (getvar 'ucsxdir)))))
  (setq ss (ssget "_A"))
  (ssdel ray ss)
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
    (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object e) acextendnone))
    (setq ippl (append ipp ippl))
  )
  (setq ipp nil)
  (repeat (/ (length ippl) 3)
    (setq ipp (cons (list (car ippl) (cadr ippl) (caddr ippl)) ipp))
    (setq ippl (cdddr ippl))
  )
  (setq ippl (vl-sort ipp '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (if (vlax-curve-getparamatpoint ent (car ippl))
      (setq e ent)
    )
  )
  (entdel ray)
  (command "_.COPYBASE" "_non" '(0.0 0.0 0.0) e "")
  (command "_.UNDO" "_B")
  (command "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
  (sssetfirst nil (ssadd (entlast)))
  (*error* nil)
)

Regards, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-07-2016

And now final touch... I think this is as much as good as LISP can offer, but it could be slow... And to mention, you must have it visible on screen, so no real BNDR like yours... At least the code is readable, so maybe someone can learn from it or use it somehow... I think I could get at least kudo for effort I showed... M.R.

(defun c:bndr ( / *error* unit bbucs *adoc* pea pck ss p bb dx dy kx ky pp ipp1 ipp2 ippl1 ippl2 rec pl pll li1 li2 i1 c1 i2 c2 ip ipl trl s el sx ii cx k e i ray ipp ippl )

  (vl-load-com)

  (defun *error* ( m )
    (if pea
      (setvar 'peditaccept pea)
    )
    (if pck
      (setvar 'pickbox pck)
    )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun unit ( v )
    (if (not (equal v '(0.0 0.0 0.0) 1e-6))
      (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
    )
  )

  (defun bbucs ( ss / UCS2WCSMatrix WCS2UCSMatrix n ent minpt maxpt minptlst maxptlst minptbbx minptbby minptbbz minptbb maxptbbx maxptbby maxptbbz maxptbb )

    (vl-load-com)

    ;; Doug C. Broad, Jr.
    ;; can be used with vla-transformby to
    ;; transform objects from the UCS to the WCS
    (defun UCS2WCSMatrix ()
      (vlax-tmatrix
        (append
          (mapcar
           '(lambda (vector origin)
            (append (trans vector 1 0 t) (list origin))
          )
          (list '(1 0 0) '(0 1 0) '(0 0 1))
          (trans '(0 0 0) 0 1)
          )
          (list '(0 0 0 1))
        )
      )
    )
    ;; transform objects from the WCS to the UCS
    (defun WCS2UCSMatrix ()
      (vlax-tmatrix
        (append
          (mapcar
           '(lambda (vector origin)
            (append (trans vector 0 1 t) (list origin))
          )
          (list '(1 0 0) '(0 1 0) '(0 0 1))
          (trans '(0 0 0) 1 0)
          )
          (list '(0 0 0 1))
        )
      )
    )

    (if ss
      (progn
        (repeat (setq n (sslength ss))
          (setq ent (ssname ss (setq n (1- n))))
          (vla-TransformBy (vlax-ename->vla-object ent) (UCS2WCSMatrix))
          (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
          (vla-TransformBy (vlax-ename->vla-object ent) (WCS2UCSMatrix))
          (setq minpt (vlax-safearray->list minpoint))
          (setq maxpt (vlax-safearray->list maxpoint))
          (setq minptlst (cons minpt minptlst))
          (setq maxptlst (cons maxpt maxptlst))
        )
        (setq minptbbx (caar (vl-sort minptlst '(lambda (a b) (< (car a) (car b))))))
        (setq minptbby (cadar (vl-sort minptlst '(lambda (a b) (< (cadr a) (cadr b))))))
        (setq minptbbz (caddar (vl-sort minptlst '(lambda (a b) (< (caddr a) (caddr b))))))
        (setq maxptbbx (caar (vl-sort maxptlst '(lambda (a b) (> (car a) (car b))))))
        (setq maxptbby (cadar (vl-sort maxptlst '(lambda (a b) (> (cadr a) (cadr b))))))
        (setq maxptbbz (caddar (vl-sort maxptlst '(lambda (a b) (> (caddr a) (caddr b))))))
        (setq minptbb (list minptbbx minptbby minptbbz))
        (setq maxptbb (list maxptbbx maxptbby maxptbbz))
      )
    )
    (list minptbb maxptbb)
  )

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (setq pea (getvar 'peditaccept))
  (setvar 'peditaccept 1)
  (setq pck (getvar 'pickbox))
  (prompt "\nSelect boundary curve entities...")
  (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  (while (not ss)
    (prompt "\nSource curve boundary sel. set empty... Please reselect boundary curves on unlocked layer(s) again...")
    (setq ss (ssget "_:L" '((0 . "*POLYLINE,LINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
  )
  (initget 1)
  (setq p (getpoint "\nPick or specify internal point : "))
  (setvar 'pickbox 1)
  (setq bb (bbucs ss))
  (setq bb (subst (list (car (car bb)) (cadr (car bb)) 0.0) (car bb) bb))
  (setq bb (subst (list (car (cadr bb)) (cadr (cadr bb)) 0.0) (cadr bb) bb))
  (setq dx (/ (abs (- (car (cadr bb)) (car (car bb)))) 10.0))
  (setq dy (/ (abs (- (cadr (cadr bb)) (cadr (car bb)))) 10.0))
  (setq ky 0)
  (repeat 9
    (setq ky (1+ ky))
    (setq kx 0)
    (repeat 9
      (setq kx (1+ kx))
      (setq pp (list (+ (car (car bb)) (* kx dx)) (+ (cadr (car bb)) (* ky dy)) 0.0))
      (if (and (/= kx 1) (/= ky 1) (/= kx 9) (/= ky 9))
        (setq pl (cons pp pl))
      )
    )
  )
  (setq rec
    (entmakex
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)
        '(70 . 1)
        (cons 38 (caddr (trans (car bb) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (car bb))
        (cons 10 (list (car (cadr bb)) (cadr (car bb))))
        (cons 10 (cadr bb))
        (cons 10 (list (car (car bb)) (cadr (cadr bb))))
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )
  (foreach pp pl
    (setq li1 (entmakex (list '(0 . "LINE") (cons 10 (trans p 1 0)) (cons 11 (trans pp 1 0)))))
    (setq li2 (entmakex (list '(0 . "LINE") (cons 10 (trans pp 1 0)) (cons 11 (vlax-curve-getclosestpointto rec (trans pp 1 0))))))
    (setq ippl1 nil ippl2 nil)
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i))))
      (setq ipp1 (vlax-invoke (vlax-ename->vla-object li1) 'intersectwith (vlax-ename->vla-object e) acextendnone))
      (setq ippl1 (append ipp1 ippl1))
      (setq ipp2 (vlax-invoke (vlax-ename->vla-object li2) 'intersectwith (vlax-ename->vla-object e) acextendnone))
      (setq ippl2 (append ipp2 ippl2))
    )
    (if (and (or (null ippl1) (= 0 (rem (length ippl1) 6))) (not (null ippl2)))
      (setq pll (cons pp pll))
    )
    (entdel li1)
    (entdel li2)
  )
  (entdel rec)
  ;|
  (foreach pp pll
    (entmake (list '(0 . "POINT") (cons 10 (trans pp 1 0))))
  )
  |;
  (repeat (setq i1 (sslength ss))
    (setq c1 (ssname ss (setq i1 (1- i1))))
    (ssdel c1 ss)
    (repeat (setq i2 (sslength ss))
      (setq c2 (ssname ss (setq i2 (1- i2))))
      (setq ip (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object c2) acextendnone))
      (if ip
        (repeat (/ (length ip) 3)
          (setq ipl (cons (list (car ip) (cadr ip) (caddr ip)) ipl))
          (setq ip (cdddr ip))
        )
      )
    )
    (setq ipl (vl-sort ipl '(lambda ( a b ) (< (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)))))
    (mapcar
     '(lambda ( a b / ray ipp ippl v )
        (foreach pp pll
          (setq ippl nil)
          (setq v (unit (mapcar '- (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (trans pp 1 0))))
          (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans pp 1 0)) (cons 11 v))))
          (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c1) acextendnone))
          (repeat (setq i2 (sslength ss))
            (setq c2 (ssname ss (setq i2 (1- i2))))
            (setq ipp (append (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object c2) acextendnone) ipp))
          )
          (if ipp
            (repeat (/ (length ipp) 3)
              (setq ippl (cons (list (car ipp) (cadr ipp) (caddr ipp)) ippl))
              (setq ipp (cdddr ipp))
            )
          )
          (if (equal (vlax-curve-getpointatparam c1 (/ (+ (vlax-curve-getparamatpoint c1 a) (vlax-curve-getparamatpoint c1 b)) 2.0)) (car (setq ippl (vl-sort ippl '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))) 1e-6)
            (if (not (vl-position (list a c1 b) trl))
              (setq trl (cons (list a c1 b) trl))
            )
          )
          (entdel ray)
        )
      )
      ipl
      (cdr ipl)
    )
    (setq ipl nil)
    (ssadd c1 ss)
  )
  (foreach tr trl
    (repeat (1- (length (vl-remove-if-not '(lambda ( x ) (eq (cadr tr) (cadr x))) trl)))
      (setq trl (subst (list (car tr) (vlax-vla-object->ename (vla-copy (vlax-ename->vla-object (cadr tr)))) (caddr tr) t) tr trl))
    )
  )
  (foreach tr trl
    (if (eq (last tr) t)
      (entdel (cadr tr))
    )
  )
  (setq s (ssadd))
  (foreach tr (vl-remove-if '(lambda ( x ) (eq (last x) t)) trl)
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (foreach tr (vl-remove-if-not '(lambda ( x ) (eq (last x) t)) trl)
    (entdel (cadr tr))
    (setq el (entlast))
    (if
      (not
        (or
          (equal (vlax-curve-getstartpoint (cadr tr)) (car tr) 1e-6)
          (equal (vlax-curve-getendpoint (cadr tr)) (car tr) 1e-6)
        )
      )
      (progn
        (setq cx (entget (cadr tr)))
        (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.1) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.01) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) 0.001)))))) 0 1) "")
        (setq k 0)
        (while (equal cx (entget (cadr tr)) 1e-6)
          (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.1)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.01)) (if (> (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001)) (- (vlax-curve-getparamatpoint (cadr tr) (car tr)) (* k 0.001))))))) 0 1) "")
        )
      )
    )
    (cond
      ( (and (not (eq el (entlast))) (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr))))
        (if (not (eq (cadr tr) (entlast)))
          (entdel (cadr tr))
        )
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (entlast)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (entlast)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (entlast)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (entlast)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (entlast) (vlax-curve-getpointatparam (entlast) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (entlast)) (vlax-curve-getparamatpoint (entlast) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (entlast) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (if (not (vlax-erased-p (cadr tr)))
                (ssadd (cadr tr) s)
                (progn
                  (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                  (repeat (setq ii (sslength sx))
                    (if
                      (or
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                        )
                        (and
                          (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                          (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                        )
                      )
                      (ssadd (ssname sx ii) s)
                    )
                  )
                )
              )
            )
            (if (not (vlax-erased-p (cadr tr)))
              (ssadd (cadr tr) s)
              (progn
                (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
                (repeat (setq ii (sslength sx))
                  (if
                    (or
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx (setq ii (1- ii)))) (car tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (caddr tr) 1e-6)
                      )
                      (and
                        (equal (vlax-curve-getstartpoint (ssname sx ii)) (caddr tr) 1e-6)
                        (equal (vlax-curve-getendpoint (ssname sx ii)) (car tr) 1e-6)
                      )
                    )
                    (ssadd (ssname sx ii) s)
                  )
                )
              )
            )
          )
        )
      )
      ( (and (not (eq el (entlast))) (not (and (vlax-curve-getparamatpoint (cadr tr) (car tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr)))))
        (entdel (cadr tr))
        (setq sx (ssget "_C" (trans (car tr) 0 1) (trans (car tr) 0 1)))
        (setq e (car (vl-remove-if-not '(lambda ( x ) (vlax-curve-getparamatpoint x (caddr tr))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sx))))))
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint e) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint e) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget e))
            (if (< (vlax-curve-getparamatpoint e (car tr)) (vlax-curve-getparamatpoint e (caddr tr)))
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam e) (vlax-curve-getparamatpoint e (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
              (progn
                (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.1) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.1) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.01) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.01) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) 0.001) (- (vlax-curve-getparamatpoint e (caddr tr)) 0.001)))))) 0 1) "")
                (setq k 0)
                (while (equal cx (entget e) 1e-6)
                  (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto e (vlax-curve-getpointatparam e (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* (setq k (1+ k)) 0.1)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.01)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getparamatpoint e (caddr tr)) (vlax-curve-getstartparam e)) (* k 0.001)) (- (vlax-curve-getparamatpoint e (caddr tr)) (* k 0.001))))))) 0 1) "")
                )
              )
            )
          )
        )
        (ssadd e s)
      )
      ( t
        (if
          (not
            (or
              (equal (vlax-curve-getstartpoint (cadr tr)) (caddr tr) 1e-6)
              (equal (vlax-curve-getendpoint (cadr tr)) (caddr tr) 1e-6)
            )
          )
          (progn
            (setq cx (entget (cadr tr)))
            (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.1) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.1) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.01) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.01) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) 0.001) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) 0.001)))))) 0 1) "")
            (setq k 0)
            (while (equal cx (entget (cadr tr)) 1e-6)
              (command "_.TRIM" "" "_nea" (trans (vlax-curve-getclosestpointto (cadr tr) (vlax-curve-getpointatparam (cadr tr) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* (setq k (1+ k)) 0.1)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.1)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.01)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.01)) (if (> (- (vlax-curve-getendparam (cadr tr)) (vlax-curve-getparamatpoint (cadr tr) (caddr tr))) (* k 0.001)) (+ (vlax-curve-getparamatpoint (cadr tr) (caddr tr)) (* k 0.001))))))) 0 1) "")
            )
          )
        )
        (if (and (vlax-curve-getparamatpoint (entlast) (car tr)) (vlax-curve-getparamatpoint (entlast) (caddr tr)))
          (ssadd (entlast) s)
          (if (not (eq el (entlast)))
            (progn
              (entdel (entlast))
              (ssadd (cadr tr) s)
            )
            (ssadd (cadr tr) s)
          )
        )
      )
    )
  )
  (if (vl-some '(lambda ( x ) (if (wcmatch (cdr (assoc 0 (entget x))) "SPLINE,ELLIPSE") (setq e x))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
    (command "_.JOIN" e s "")
    (progn
      (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0)
      (while (< 0 (getvar 'cmdactive))
        (command "")
      )
    )
  )
  (setq ray (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 (trans p 1 0)) (cons 11 (getvar 'ucsxdir)))))
  (setq ss (ssget "_A"))
  (ssdel ray ss)
  (repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
    (setq ipp (vlax-invoke (vlax-ename->vla-object ray) 'intersectwith (vlax-ename->vla-object e) acextendnone))
    (setq ippl (append ipp ippl))
  )
  (setq ipp nil)
  (repeat (/ (length ippl) 3)
    (setq ipp (cons (list (car ippl) (cadr ippl) (caddr ippl)) ipp))
    (setq ippl (cdddr ippl))
  )
  (setq ippl (vl-sort ipp '(lambda ( a b ) (< (vlax-curve-getparamatpoint ray a) (vlax-curve-getparamatpoint ray b)))))
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (if (vlax-curve-getparamatpoint ent (car ippl))
      (setq e ent)
    )
  )
  (entdel ray)
  (command "_.COPYBASE" "_non" '(0.0 0.0 0.0) e "")
  (command "_.UNDO" "_B")
  (command "_.PASTECLIP" "_non" '(0.0 0.0 0.0))
  (sssetfirst nil (ssadd (entlast)))
  (*error* nil)
)

Marko Ribar, d.i.a. (graduated engineer of architecture)

marko_ribar · ‎06-07-2016

Sorry...

This

  (setq rec
    (entmakex
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)
        '(70 . 1)
        (cons 38 (caddr (trans (car bb) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (car bb))
        (cons 10 (list (car (cadr bb)) (cadr (car bb))))
        (cons 10 (cadr bb))
        (cons 10 (list (car (car bb)) (cadr (cadr bb))))
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )

Should be

  (setq rec
    (entmakex
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)
        '(70 . 1)
        (cons 38 (caddr (trans (car bb) 1 (trans '(0.0 0.0 1.0) 1 0 t))))
        (cons 10 (trans (car bb) 1 (trans '(0.0 0.0 1.0) 1 0 t)))
        (cons 10 (trans (list (car (cadr bb)) (cadr (car bb))) 1 (trans '(0.0 0.0 1.0) 1 0 t)))
        (cons 10 (trans (cadr bb) 1 (trans '(0.0 0.0 1.0) 1 0 t)))
        (cons 10 (trans (list (car (car bb)) (cadr (cadr bb))) 1 (trans '(0.0 0.0 1.0) 1 0 t)))
        (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))
      )
    )
  )

Now where is that kudo?

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

ВeekeeCZ · ‎06-07-2016

Watching silently from a distance... It's certainly impressive! Very hope that the OP finds this useful!

marko_ribar · ‎06-07-2016

Thanks for the kudo BeekeeCZ... I am wondering how many bedges you must have to become Expert Elite??? If you need some I can help you in that manner...

Marko Ribar, d.i.a. (graduated engineer of architecture)

ВeekeeCZ · ‎06-07-2016

@marko_ribar wrote:

Thanks for the kudo BeekeeCZ... I am wondering how many bedges you must have to become Expert Elite??? If you need some I can help you in that manner...

I have no idea! Still have a lot to learn! Thanks for the offer 😉 but... please don't.

dgorsman · ‎06-07-2016

EE membership is a matter of being nominated for consideration to the EE committee. For more information, see here: http://www.autodesk.com/expert-elite/about

----------------------------------
If you are going to fly by the seat of your pants, expect friction burns.
"I don't know" is the beginning of knowledge, not the end.

Community

alternative of _BOUNDARY in the mode of pick point

alternative of _BOUNDARY in the mode of pick point

alternative of _BOUNDARY in the mode of pick point