find each boundary of the select object

```
;;; ========================================================================
;;; Some of the following code are writen by QJCHEN
;;; Civil engineering Department, South China University of Technology
;;; Purpose: To Find each closed boundary in the selection
;;; Version: 0.1
;;; Limitation: Can't generate the boundary by spline
;;; 2006.06.01
;;; Thanks to the code from Korea friend from http://xoutside.com/
;;; whose code find the intersections of two points and many object
;;; And thanks to the initial code from Mr.Tony Hotchkiss at Cadalyst
;;; Original post :www.Theswamp.org
;;; ========================================================================

(defun c:bb (/ clayer a b dis ay by th th0 lp rp inter1 inter1mid inter2
inter2mid i len plboundary
)
(command "_undo" "_be")
(startTimer)
(setting)
(setq clayer (getvar "clayer"))
(command "_layer" "n" "bound" "s" "bound" "c" 3 "" "")
(setq a (getpoint "\n the left up point"))
(setq b (getcorner a "\n the bottom right point"))
(setq dis (getdist "\n the minimum distance"))
(setq ay (nth 1 a)
by (nth 1 b)
)
(setq th by)
(setq th0 dis)
(while (< th ay)
(setq lp (list (nth 0 a) th 0))
(setq rp (list (nth 0 b) th 0))
(grdraw lp rp 249)
(setq inter1 (vl-Get-Int-Pt lp rp "bound" 0))
(setq inter1mid (midlist inter1))
(setq inter2 (vl-Get-Int-Pt lp rp "bound" 1)
inter2mid (midlista inter2)
)
(command "_layer" "s" "bound" "")
(setq i 0
len (length inter1)
)
(repeat (1- len)
(setq midpoint (nth i inter1mid))
(if (not (member1 midpoint inter2mid))
(progn
(setq plboundary (STD-BPOLY midpoint nil))
(if plboundary
(setq inter2 (vl-Get-Int-Pt lp rp "bound" 1)
inter2mid (midlista inter2)
)
)
)
)
(setq i (1+ i))
)
(command "_layer" "s" clayer "")
(setq th (+ th th0))
)
(resetting)
(endTimer (vl-symbol-name 'c:bb))
(command "_undo" "_e")
)

;
(defun member1 (a b / res)
(if b
(foreach x b
(if (< (distance x a) 0.01)
(progn
(setq res T)
)			       ; (setq res nil)
)
)				       ; (setq res nil)
)
res
)
(defun midlist (lst / len lst1 midpoint i)
(setq i 0
len (length lst)
)
(repeat (1- len)
(setq midpoint (midp (nth i lst) (nth (1+ i) lst)))
(setq lst1 (append
lst1
(list midpoint)
)
)
(setq i (1+ i))
)
lst1
)
(defun midlista (lst / len lst1 midpoint i)
(setq i 0
len (length lst)
)
(repeat (/ len 2)
(setq midpoint (midp (nth i lst) (nth (1+ i) lst)))
(setq lst1 (append
lst1
(list midpoint)
)
)
(setq i (+ i 2))
)
lst1
)

;;; -----------------------------------------------------------------
;;; | The following code taken xarch.tu-graz.ac.at/autocad/stdlib/  |
;;; | Thanks to the great code "STDLIB" that wrote by MR.Reini Urban|
;;; -----------------------------------------------------------------

(defun STD-BPOLY (pt ss / ele)
(cond
((member (type C:BPOLY) '(SUBR EXRXSUBR EXSUBR))
(if ss
(C:BPOLY pt ss)		       ; old arx or ads function
(C:BPOLY pt)
)
)
(pt				       ; >=r14: native command
(setvar "CMDDIA" 0)
(setq ele (entlast))	       ; (std-break-command)
(command "_BPOLY" "_A" "_I" "_N" "") ; advanced options
; without island detection
(if ss
(command "_B" "_N" ss "")
)			       ; define boundary set if ss
(command "" pt "") (setvar "CMDDIA" 1)
(if (/= (entlast) ele)
(entlast)
)
)				       ; return created BPOLY
(T
)
)
)

;;; -------------------------------------------------------------------
;;; | The following code are taken from xoutside.com                  |
;;; | Thanks to the Korea friend                                      |
;;; | Purpose: Get the intersection of Two object                     |
;;; -------------------------------------------------------------------

(defun vl-Get-Int-Pt (FirstPoint SecondPoint lay layindex / acadDocument
mSpace SSetName SSets SSet reapp ex obj
Baseline
)
(setq SSetName "MySSet")
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list SSets
SSetName
)
)
)
(vla-clear (vla-Item SSets SSetName))
)
(setq SSet (vla-Item SSets SSetName))
(setq Baseline (vla-Addline mspace (vlax-3d-point FirstPoint)
(vlax-3d-point SecondPoint)
)
)
(vla-SelectByPolygon SSet acSelectionSetFence
(kht:list->safearray (append
FirstPoint
SecondPoint
) 'vlax-vbdouble
)
)
(vlax-for obj sset (if (setq ex (kht-intersect
(vlax-vla-object->ename BaseLine)
(vlax-vla-object->ename obj)
lay layindex
)
)
(setq reapp (append
reapp
ex
)
)
)
)
(vla-delete BaseLine)
(setq reapp (vl-sort reapp '(lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
reapp
)

;;; Modify little by QJCHEN to filter TEXT SPLINE and layer
(defun kht-intersect (en1 en2 lay layindex / a b x ex ex-app c d e la2)
(setq c (cdr (assoc 0 (entget en1)))
d (cdr (assoc 0 (entget en2)))
la2 (cdr (assoc 8 (entget en2)))
)
(if (or
(= c "TEXT")
(= d "TEXT")
(= c "SPLINE")
(= d "SPLINE")
)
(setq e -1)
)
(if (= layindex 0)
(if (= la2 lay)
(setq e -1)
)
)
(if (= layindex 1)
(if (/= la2 lay)
(setq e -1)
)
)
(setq En1 (vlax-ename->vla-object En1))
(setq En2 (vlax-ename->vla-object En2))
(setq a (vla-intersectwith en1 en2 acExtendNone))
(setq a (vlax-variant-value a))
(setq b (vlax-safearray-get-u-bound a 1))
(if (= e -1)
(setq b e)
)
(if (/= b -1)
(progn
(exapp a)
)
nil
)
)

(defun exapp (a)
(setq a (vlax-safearray->list a))
(repeat (/ (length a) 3)
(setq ex-app (append
ex-app
)
)
(setq a (cdr (cdr (cdr a))))
)
ex-app
)

(defun kht:list->safearray (lst datatype)
(vlax-safearray-fill (vlax-make-safearray (eval datatype) (cons 0
(1-
(length lst)
)
)
) lst
)
)

;;; ----------------------------------------------------------
;;; |           midpoint function                            |
;;; ----------------------------------------------------------
(defun midp (p1 p2)
(mapcar
'(lambda (x)
(/ x 2.)
)
(mapcar
'+
p1
p2
)
)
)

;;; -----------------------------------------------------------------
;;; | The following code taken from Mr.Tony Hotchkiss at Cadalyst   |
;;; | To set and reset the system variable                          |
;;; -----------------------------------------------------------------

(defun err (s)
(if (= s "Function cancelled")
(princ "\nALIGNIT - cancelled: ")
(progn
(princ "\nALIGNIT - Error: ")
(princ s)
(terpri)
)				       ; _ end of progn
)	 			       ; _ end of if
(resetting)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
)
;;; err
;;; setting and resetting the system variables
(defun setv (systvar newval / x)
(setq x (read (strcat systvar "1")))
(set x (getvar systvar))
(setvar systvar newval)
)
;;; setv
(defun setting ()
(setq oerr *error*)
(setq *error* err)
(setv "BLIPMODE" 0)
(setv "CMDECHO" 0)
(setv "OSMODE" 0)
)
;;; setting
(defun rsetv (systvar)
(setq x (read (strcat systvar "1")))
(setvar systvar (eval x))
)
;;; rsetv
(defun resetting ()
(rsetv "BLIPMODE")
(rsetv "CMDECHO")
(rsetv "OSMODE")
(setq *error* oerr)
)

;;; -----------------------------------------------------------------
;;; | The following code taken from www.theswamp.org                |
;;; | To calculate the time that the program run                    |
;;; -----------------------------------------------------------------

(defun startTimer ()
(setq time (getvar "DATE"))
)
(defun endTimer (func)
(setq time (- (getvar "DATE") time)
seconds (* 86400.0 (- time (fix time)))
)
(gc)
(outPut seconds func)
)
(defun outPut (secs def)
(princ "\nPurging...")
(command "PURGE" "Layers" "*" "N")
(gc)
(princ (strcat "\nTimed " def ": " (rtos secs 2 6)))
(princ)
)

(princ "\n Please use the bb command to run")

```