Routine to break entities at ALL intersections?

[rkitek]

First off, greetings to all of you code gurus. I'm glad to have found a place to learn a little bit about writing programs for acad!

Second, a little background regarding my question. In our office (architectural) we've been playing around with modeling in Sketchup for conceptualization. The biggest difficulty I'm having is that when you import a .dwg base plan, lines/arcs/circles/etc which intersect need to be 'broken' at that intersection point for Sketchup to recognize a 'bound' area and create a face for extrusion. The problem is correctable in both programs, but it's very tedious to break the individual entities at each individual intersection.

So, here's the 2 million dollar question: Is there any way to write a routine that will break all entities at all intersections? So far noone has had any success writing the ruby script for Sketchup that would achieve this result, so I thought maybe it would be possible to script it from the acad end...any ideas would be greatly appreciated!

-Thanks

[Bob Wahr]

it can't be done with a script but I'm pretty sure that's not what you meant by "script it".  It could be done with lisp or vba but it would not be a quick or easy program to do.

[rkitek]

After a little more searching I've found an program that'll do exactly what I need.

http://www.synapse-informatique.com/qbrick_en.htm

Thanks for the response Bob...

[Bob Wahr]

cool.  I thought you were wanting something that would go through an entire drawing and do all of the breaks.  If that works for you, great.

[qjchen]

by learning the code of CAB, I write down the following code.
Thanks to CAB and the Korea friend from xoutside.com

note:the color in the picture is not produced by program,.

Code:

;;; Some of the following code are writen by QJCHEN
;;; South China University of Technology
;;; Purpose: To Break all the entities at intersection
;;; Version: 0.1
;;; Limitation: For self intersect object,need run twice
;;; 2006.05.27
;;; Thanks to the Great code from Charles Alan Butler & Will DeLoach at
;;; Theswamp.org
;;; and the Korea friend from [url]http://xoutside.com/[/url]
(defun c:brkall(/ a b i p selset j ent)
  (command ".undo" "be")
  (setting)
  (prompt "\nSelect objects to break: ")
  (setq a (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
  (setq b (findallintersction a))
  (setq i 0)
  (repeat (length b)
    (setq p (nth i b))
    (setq selset (selectatonepoint p))
    (setq j 0)
    (repeat (sslength selset)
      (setq ent (ssname selset j))
      (newbreak ent p)               ; (command "._break" ent p "@")
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
  (resetting)
  (command ".undo" "e")
  (princ)
)
;;; by Q.J.CHEN
;;; Purpose: To Select entities at one point
;;; The "tor" control the minimum distance between two point
(defun selectatonepoint (a / tor p1 p2 ss)
  (setq tor 0.01)
  (setq p1 (polar a (* (/ 135 180) pi) tor))
  (setq p2 (polar a (* (/ 315 180) pi) tor))
  (setq ss (ssget "_c" p1 p2))           ; (command "erase" ss "")
  ss
)
;;; by Q.J.CHEN
;;; Purpose: To Find all intersection in one ssget set
(defun findallintersction (sset / interlst ssl i e1 j e2 l)
  (setq interlst nil)
  (setq ssl (sslength sset)
    i 0
  )
  (repeat ssl
    (setq e1 (ssname sset i))
    (setq j (1+ i))
    (repeat (- ssl (1+ i))
      (setq e2 (ssname sset j))
      (setq l (kht-intersect e1 e2))
      (setq interlst (append
               interlst
               l
             )
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
  interlst
)
;;; The following code are taken from xoutside.com
;;; http://xoutside.com/CAD/lisp/lisp_chair.htm
;;; Thanks to the Korea friend
;;; Purpose: Get the intersection of Two object
(defun kht-intersect (en1 en2 / a b x ex ex-app c d e)
  (vl-load-com)
  (setq c (cdr (assoc 0 (entget en1)))
    d (cdr (assoc 0 (entget en2)))
  )
  (if (or
    (= c "TEXT")
    (= d "TEXT")
      )
    (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
      (setq a (vlax-safearray->list a))
      (repeat (/ (length a) 3)
    (setq ex-app (append
               ex-app
               (list (list (car a) (cadr a) (caddr a)))
             )
    )
    (setq a (cdr (cdr (cdr a))))
      )
      ex-app
    )
    nil
  )
)
(defun kht:list->safearray (lst datatype)
  (vlax-safearray-fill (vlax-make-safearray (eval datatype) (cons 0
                                  (1-
                                      (length lst)
                                  )
                                )
               ) lst
  )
)
;;; The following code are writen by Charles Alan Butler & Will DeLoach
;;; who come from Theswamp.org
;;; =======================[ BreakAtObject.lsp ]=======================
;;; Author: Charles Alan Butler & Will DeLoach
;;; Version:  1.5 Feb. 22, 2006
;;; Purpose: Break lines, plines, splines, ellipse, circles & arcs
;;;          with a crossing object or user line, not blocks
;;; Sub_Routines: ssget->vla-list
;;;               list->3pair
;;; Requirements:
;;; Returns:
;;; ==============================================================
;;;  Ignores objects on locked layers
;;;  This code is still under deveopment
(defun newbreak (ent pt / obj2Break p1param p2param p2)
  (setq obj2Break (vlax-ename->vla-object ent))
  (cond
    ((and
       (= "AcDbSpline" (vla-get-objectname obj2Break)) ; only closed
                       ; splines
       (vlax-curve-isClosed obj2Break)
     )
      (setq p1param (vlax-curve-getparamatpoint obj2Break pt)
        p2param (+ p1param 0.000001)
        p2 (vlax-curve-getPointAtParam obj2Break p2param)
      )
      (command "._break" (vlax-vla-object->ename obj2Break) "non"
           (trans pt 0 1) "non" (trans p2 0 1)
      )
    )
    ((= "AcDbCircle" (vla-get-objectname obj2Break)) ; break the circle
      (setq p1param (vlax-curve-getparamatpoint obj2Break pt)
        p2param (+ p1param 0.000001)
        p2 (vlax-curve-getPointAtParam obj2Break p2param)
      )
      (command "._break" (vlax-vla-object->ename obj2Break) "non"
           (trans pt 0 1) "non" (trans p2 0 1)
      )
      (setq en (entlast))
    )
    ((and
       (= "AcDbEllipse" (vla-get-objectname obj2Break))    ; only closed
                       ; ellipse
       (vlax-curve-isClosed obj2Break)
     )                       ;  Break the ellipse, code borrowed
                       ; from Joe Burke  6/6/2005
      (setq p1param (vlax-curve-getparamatpoint obj2Break pt)
        p2param (+ p1param 0.000001) ; (vlax-curve-getparamatpoint obj
                       ; p2)
        minparam (min
               p1param
               p2param
             )
        maxparam (max
               p1param
               p2param
             )
      )
      (vlax-put obj2Break 'startparameter maxparam)
      (vlax-put obj2Break 'endparameter (+ minparam (* pi 2)))
    )                       ; ==================================
                       ;   Objects that can be broken
                       ; ==================================
    (t
      (command "._break" ent pt "@")
    )
  )
)
;;; The following code taken from Mr.Tony Hotchkiss at Cadalyst
(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)
)
;;; -------------------------------------------------------

[CADaver]

hmmm.... BOUNDARY now begs investigation ... hmmm...

[CAB]

yuanqiu nice work.
And welcome to the swamp.

[Joe Burke]

After a little more searching I've found an program that'll do exactly what I need.

http://www.synapse-informatique.com/qbrick_en.htm

Thanks for the response Bob...

Interesting... appears well done at first glance. But try it with a pline pedited to a spline and some other objects. For instance a line crossing the spline and the QBRICK command. Fatal error crash every time as far as I can tell.

Regardless, I'd love to see the code behind it.

[Andrea]

Modified for All language compaptibilities ..

Thanks.

Code:

;;; Some of the following code are writen by QJCHEN
;;; South China University of Technology
;;; Purpose: To Break all the entities at intersection
;;; Version: 0.1
;;; Limitation: For self intersect object,need run twice
;;; 2006.05.27
;;; Thanks to the Great code from Charles Alan Butler & Will DeLoach at
;;; Theswamp.org
;;; and the Korea friend from [url]http://xoutside.com/[/url]
;;; Modified By Andrea Andreetti for All language compaptibilities May 26 2006
(defun c:brkall(/ a b i p selset j ent)
  (command "_undo" "_be")
  (setting)
  (prompt "\nSelect objects to break: ")
  (setq a (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
  (setq b (findallintersction a))
  (setq i 0)
  (repeat (length b)
    (setq p (nth i b))
    (setq selset (selectatonepoint p))
    (setq j 0)
    (repeat (sslength selset)
      (setq ent (ssname selset j))
      (newbreak ent p)               ; (command "._break" ent p "@")
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
  (resetting)
  (command "_undo" "_e")
  (princ)
)
;;; by Q.J.CHEN
;;; Purpose: To Select entities at one point
;;; The "tor" control the minimum distance between two point
(defun selectatonepoint (a / tor p1 p2 ss)
  (setq tor 0.01)
  (setq p1 (polar a (* (/ 135 180) pi) tor))
  (setq p2 (polar a (* (/ 315 180) pi) tor))
  (setq ss (ssget "_c" p1 p2))           ; (command "erase" ss "")
  ss
)
;;; by Q.J.CHEN
;;; Purpose: To Find all intersection in one ssget set
(defun findallintersction (sset / interlst ssl i e1 j e2 l)
  (setq interlst nil)
  (setq ssl (sslength sset)
    i 0
  )
  (repeat ssl
    (setq e1 (ssname sset i))
    (setq j (1+ i))
    (repeat (- ssl (1+ i))
      (setq e2 (ssname sset j))
      (setq l (kht-intersect e1 e2))
      (setq interlst (append
               interlst
               l
             )
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
  interlst
)
;;; The following code are taken from xoutside.com
;;; http://xoutside.com/CAD/lisp/lisp_chair.htm
;;; Thanks to the Korea friend
;;; Purpose: Get the intersection of Two object
(defun kht-intersect (en1 en2 / a b x ex ex-app c d e)
  (vl-load-com)
  (setq c (cdr (assoc 0 (entget en1)))
    d (cdr (assoc 0 (entget en2)))
  )
  (if (or
    (= c "TEXT")
    (= d "TEXT")
      )
    (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
      (setq a (vlax-safearray->list a))
      (repeat (/ (length a) 3)
    (setq ex-app (append
               ex-app
               (list (list (car a) (cadr a) (caddr a)))
             )
    )
    (setq a (cdr (cdr (cdr a))))
      )
      ex-app
    )
    nil
  )
)
(defun kht:list->safearray (lst datatype)
  (vlax-safearray-fill (vlax-make-safearray (eval datatype) (cons 0
                                  (1-
                                      (length lst)
                                  )
                                )
               ) lst
  )
)
;;; The following code are writen by Charles Alan Butler & Will DeLoach
;;; who come from Theswamp.org
;;; =======================[ BreakAtObject.lsp ]=======================
;;; Author: Charles Alan Butler & Will DeLoach
;;; Version:  1.5 Feb. 22, 2006
;;; Purpose: Break lines, plines, splines, ellipse, circles & arcs
;;;          with a crossing object or user line, not blocks
;;; Sub_Routines: ssget->vla-list
;;;               list->3pair
;;; Requirements:
;;; Returns:
;;; ==============================================================
;;;  Ignores objects on locked layers
;;;  This code is still under deveopment
(defun newbreak (ent pt / obj2Break p1param p2param p2)
  (setq obj2Break (vlax-ename->vla-object ent))
  (cond
    ((and
       (= "AcDbSpline" (vla-get-objectname obj2Break)) ; only closed
                       ; splines
       (vlax-curve-isClosed obj2Break)
     )
      (setq p1param (vlax-curve-getparamatpoint obj2Break pt)
        p2param (+ p1param 0.000001)
        p2 (vlax-curve-getPointAtParam obj2Break p2param)
      )
      (command "._break" (vlax-vla-object->ename obj2Break) "_non"
           (trans pt 0 1) "non" (trans p2 0 1)
      )
    )
    ((= "AcDbCircle" (vla-get-objectname obj2Break)) ; break the circle
      (setq p1param (vlax-curve-getparamatpoint obj2Break pt)
        p2param (+ p1param 0.000001)
        p2 (vlax-curve-getPointAtParam obj2Break p2param)
      )
      (command "._break" (vlax-vla-object->ename obj2Break) "_non"
           (trans pt 0 1) "_non" (trans p2 0 1)
      )
      (setq en (entlast))
    )
    ((and
       (= "AcDbEllipse" (vla-get-objectname obj2Break))    ; only closed
                       ; ellipse
       (vlax-curve-isClosed obj2Break)
     )                       ;  Break the ellipse, code borrowed
                       ; from Joe Burke  6/6/2005
      (setq p1param (vlax-curve-getparamatpoint obj2Break pt)
        p2param (+ p1param 0.000001) ; (vlax-curve-getparamatpoint obj
                       ; p2)
        minparam (min
               p1param
               p2param
             )
        maxparam (max
               p1param
               p2param
             )
      )
      (vlax-put obj2Break 'startparameter maxparam)
      (vlax-put obj2Break 'endparameter (+ minparam (* pi 2)))
    )                       ; ==================================
                       ;   Objects that can be broken
                       ; ==================================
    (t
      (command "._break" ent pt "@")
    )
  )
)
;;; The following code taken from Mr.Tony Hotchkiss at Cadalyst
(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)
)
;;; -------------------------------------------------------

[kamal]

Interesting... appears well done at first glance. But try it with a pline pedited to a spline and some other objects. For instance a line crossing the spline and the QBRICK command. Fatal error crash every time as far as I can tell.

Regardless, I'd love to see the code behind it.

Hi,
Thanks for reporting the bug. the program has been updated.

http://www.synapse-informatique.com/qbrick_en.htm

---
Kamal

[CAB]

Here is my version of the Break All Routine.
Works with my testing and will break all permitted objects on unlocked layers.
The breaking object may be on a locked layer.
Note that this version 1.0 and not optimized for speed. I will do that after some more testing.

Code:

;;;=======================[ BreakAll.lsp ]=======================
;;; Author: Charles Alan Butler
;;; Version:  1.0 May 28, 2006
;;; Purpose: Break All selected objects
;;;    permitted objects are lines, lwplines, plines, splines,
;;;    ellipse, circles & arcs
;;;         
;;; Sub_Routines:
;;;    ssget->vla-list
;;;    list->3pair
;;;    onlockedlayer
;;;    get_interpts Return a list of intersect points
;;;    break_obj  Break entity at break points in list
;;; Requirements: objects must have the same z-value
;;; Returns:  none
;;;==============================================================

;;  Does not Break objects on locked layers
;;  This code is still under deveopment


(defun c:breakall (/ cmd intpts lst masterlist ss ssobjs
                   onlockedlayer ssget->vla-list list->3pair
                   get_interpts break_obj
                  )
  (vl-load-com)

;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;                S U B   F U N C T I O N S                     
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

  (defun onlockedlayer (ename / entlst)
    (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
    (= 4 (logand 4 (cdr (assoc 70 entlst))))
  )
 
  (defun ssget->vla-list (ss / i ename lst)
    (setq i -1)
    (while (setq ename (ssname ss (setq i (1+ i))))
      (setq lst (cons (vlax-ename->vla-object ename) lst))
    )
    lst
  )

  (defun list->3pair (old / new)
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
                 old (cdddr old))
    )
    (reverse new)
  )
 
;;==============================================================
;;  return a list of intersect points
;;==============================================================
(defun get_interpts (obj1 obj2 / iplist)
  (if (not (vl-catch-all-error-p
             (setq iplist (vl-catch-all-apply
                            'vlax-safearray->list
                            (list
                              (vlax-variant-value
                                (vla-intersectwith obj1 obj2 acextendnone)
                              ))))))
    iplist
  )
)


;;==============================================================
;;  Break entity at break points in list
;;==============================================================
(defun break_obj (ent brkptlst / brkobjlst en enttype maxparam closedobj
                  minparam obj obj2break p1param p2 p2param
                 )

  (setq obj2break ent
        brkobjlst (list ent)
        enttype   (cdr (assoc 0 (entget ent)))
  )

  (foreach brkpt brkptlst
    ;;  get last entity created via break in case multiple breaks
    (if brkobjlst
      (progn
        ;;  if pt not on object x, switch objects
        (if (not (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj2break brkpt)))
            )
          (foreach obj brkobjlst ; find the one that pt is on
            (if (numberp (vl-catch-all-apply 'vlax-curve-getdistatpoint (list obj brkpt)))
              (setq obj2break obj) ; switch objects
            )
          )
        )
      )
    )

    ;;  Handle any objects that can not be use with the Break Command
    ;;  using one point, gap of 0.000001 is used
    (cond
      ((and (= "SPLINE" enttype) ; only closed splines
            (vlax-curve-isclosed obj2break))
       (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
             p2      (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
       )
       (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
      )
      ((= "CIRCLE" enttype) ; break the circle
       (setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
             p2      (vlax-curve-getpointatparam obj2break (+ p1param 0.000001))
       )
       (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans p2 0 1))
       (setq enttype "ARC")
      )
      ((and (= "ELLIPSE" enttype) ; only closed ellipse
            (vlax-curve-isclosed obj2break))
       ;;  Break the ellipse, code borrowed from Joe Burke  6/6/2005
       (setq p1param  (vlax-curve-getparamatpoint obj2break brkpt)
             p2param  (+ p1param 0.000001)
             minparam (min p1param p2param)
             maxparam (max p1param p2param)
             obj      (vlax-ename->vla-object obj2break)
       )
       (vlax-put obj 'startparameter maxparam)
       (vlax-put obj 'endparameter (+ minparam (* pi 2)))
      )
     
      ;;==================================
      (t  ;   Objects that can be broken     
       (setq closedobj (vlax-curve-isclosed obj2break))
       (command "._break" obj2break "_non" (trans brkpt 0 1) "_non" (trans brkpt 0 1))
       (if (not closedobj) ; new object was created
           (setq brkobjlst (cons (entlast) brkobjlst))
       )
      )
    )
  )
)
;;==============================================================



  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ;;                   S T A R T   H E R E                         
  ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  (command ".undo" "begin")
  (setq cmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)


  ;;  get objects to break
  (prompt "\nSelect objects to break: ")
  (if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
    (progn
      (setq ssobjs (ssget->vla-list ss))
      ;;  CREATE a list of entity & it's break points
      (foreach obj ssobjs ; check each object in ss
        (if (not (onlockedlayer (vlax-vla-object->ename obj)))
          (progn
            (setq lst nil)
            (foreach intobj ssobjs ; check for break pts with other objects in ss
              (if (and (not (eq obj intobj))
                       (setq intpts (get_interpts obj intobj))
                  )
                (setq lst (append (list->3pair intpts) lst)) ; entity w/ break points
              )
            )
            (if lst
              (setq masterlist (cons (cons (vlax-vla-object->ename obj) lst) masterlist))
            )
          )
        )
      )
      ;;  masterlist = ((ent brkpts)(ent brkpts)...)
      (if masterlist
        (foreach obj2brk masterlist
          (break_obj (car obj2brk) (cdr obj2brk))
        )
      )
    )
  )

  ;;------------------------------------------------------

  (setvar "CMDECHO" cmd)
  (command ".undo" "end")
  (princ)
)
(prompt "\nBreak All Loaded, Enter BreakAll to run.")
(princ)

;;  End Of File

[qjchen]

CAB, your code is much efficient than mine:)
when break horizontal 80 lines and vertical 80 lines intersection 6400
Your code need 12.998964 seconds, but mine need 19 19.288006 seconds.
Maybe I should study to optimize my code.

[CAB]

yuanqiu,
Thanks you for testing it. I think I can make it a little fast still.
But wanted to test it before the final revision.

I also see ways to improve my Break at object routine, so I'll be updating it as well.

[Andrea]

yuanqiu ...

Your version working well....since selecting a closed spline.

CAB...
Your version work.

Just let you know guys..

[qjchen]

to Andrea
Thanks for your improvement of the code:)

Because I need to found each closed boundary in the graph, I need first to do the

break all entities LISP, then I  will go through the each vertext and use the "boundary"

command to build the boundary. (The second way I am thinking is a scan line from up

to down to find the boundary, but still difficult.

Now I can only finish the edge consist of lines, and it is in very low efficiency.
It take a long time to judge whether a point is in a polygon and build boundary.

The following is the demoshow.
Because my code is still in a mess, I need time to keep them in order, then to post

here.

I found two nice program in the network:
GBPOLY at geometricad
and gbound at www.tovna.com
they all excellent, but they are all arx and time limitation, so I want to DIY, but it is too

difficult to me.