Author Topic: To find each closed boundary of selected object  (Read 18082 times)

0 Members and 1 Guest are viewing this topic.

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
To find each closed boundary of selected object
« on: May 31, 2006, 09:36:49 PM »
GBPOLY at geometricad and gbound at www.tovna.com
are all excellent program to find the boundary, but they are all arx and time limitation,
so I want to find each boundary by lisp
 
I use the method:scan line

like the graph 1, the green line from bottom to top to scan the object
then find the intersections between the green line and the object selected  fence by it.
inter1=[I1, I2, I3, I4, I5, I6]
then get the midpoint of each [I1 I2], [I2,I3] **** and get inter1mid

in each inter1mid, found the boundary by std-poly, at the same time
find the intersections between the scan line and the boundary object in

layer "bound" (I assume no other object in this layer that need to find

boundary], so get the new list
inter2=[I1' I2'] ,
inter2 will update at each production of the new boundary.
then find the midpoint of [I1' I2'], [I3' I4']   (it is different from the

inter1mid)

then if the midpoint of inter1mid is the member of the inter2mid, it

means that the boundary have made, and needn't to make again, the

progress skip to next point.

In many cases it is OK, but it sometimes make some duplicate

boundary, I should continue to improve it.

The efficiency is low, I hope you can give me some advise, thank you

very much.

Qjchen

Code: [Select]
;;; ========================================================================
;;; 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
      (alert "command _BPOLY not available")
    )
  )
)


;;; -------------------------------------------------------------------
;;; | 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 vl-Get-Int-Pt (FirstPoint SecondPoint lay layindex / acadDocument
                                 mSpace SSetName SSets SSet reapp ex obj
                                 Baseline
                     )
  (vl-load-com)
  (setq acadDocument (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq mSpace (vla-get-ModelSpace acadDocument))
  (setq SSetName "MySSet")
  (setq SSets (vla-get-SelectionSets acadDocument))
  (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
)


;;; Original post:http://xoutside.com/CAD/lisp/lisp_chair.htm
;;; 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)
  (vl-load-com)
  (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
                   (list (list (car a) (cadr a) (caddr a)))
                 )
    )
    (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")


fig.2 and fig.3 is the demoshow
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

matrix2005in

  • Guest
Re: To find each closed boundary of selected object
« Reply #1 on: May 31, 2006, 10:33:33 PM »
oh GR8 work ...........i erally appreaciate this

wonderfull...you are a star man......

ok so some out there to modify these??

i hope every one was looking for the same...

 8-)


archli

  • Mosquito
  • Posts: 1
Re: To find each closed boundary of selected object
« Reply #2 on: January 20, 2011, 08:52:12 PM »
 Excellent program!I like it very much.

hobleglobsquishyworms

  • Swamp Rat
  • Posts: 779
  • .net stuff
Re: To find each closed boundary of selected object
« Reply #3 on: March 02, 2014, 09:27:01 AM »
Anybody have a better way of doing this?

Lee Mac

  • Seagull
  • Posts: 12254
  • London, England
Re: To find each closed boundary of selected object
« Reply #4 on: March 02, 2014, 04:26:38 PM »
Anybody have a better way of doing this?

Try the attached program, based on a method by Stefan.



Compatible with Lines & straight-segmented LWPolylines.

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Re: To find each closed boundary of selected object
« Reply #5 on: March 02, 2014, 06:41:22 PM »
Thanks Lee for sharing the code.

My code is wrote long time ago and it is actually in low efficiency.

Lee Mac use "break line" like method and then to generate the region is a better method.

I have use it in .NET and it can quickly get the result.

There are some other method that can solve this problem without region command. It use the topology concept to do some loop. I have ever finish it in a project, I hope I can find the related article.
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

hobleglobsquishyworms

  • Swamp Rat
  • Posts: 779
  • .net stuff
Re: To find each closed boundary of selected object
« Reply #6 on: March 06, 2014, 07:28:08 AM »
So far I've not seen a good method of doing this with polylines with arcs / curves.   Anyone have anything they are willing to share?

snownut2

  • Swamp Rat
  • Posts: 934
  • ADT 2004 - AutoCad 2011 Bricscad 19
Re: To find each closed boundary of selected object
« Reply #7 on: March 06, 2014, 08:37:33 AM »
Use the boundary command to create the "boundary"......

Topographer

  • Swamp Rat
  • Posts: 621
Re: To find each closed boundary of selected object
« Reply #8 on: March 06, 2014, 08:42:34 AM »
nice job lee but is not working with circles ?

ronjonp

  • Needs a day job
  • Posts: 7024
Re: To find each closed boundary of selected object
« Reply #9 on: March 06, 2014, 12:39:29 PM »
nice job lee but is not working with circles ?


"Compatible with Lines & straight-segmented LWPolylines."

Windows 10 x64 - AutoCAD /C3D 2020

Custom Build PC

Stefan

  • Bull Frog
  • Posts: 220
Re: To find each closed boundary of selected object
« Reply #10 on: March 07, 2014, 05:32:21 AM »
This one works with arcs and circles, yet only in WCS.
It is supposed to work in any UCS, but for some reasons it didn't find all intersections.

In addition, this method creates a series of small regions AND a larger one, enclosing all the others, and it should be deleted.
Gian's method adds up all areas and deletes the one who's area is half; my method deletes the object with the largest area.
Both methods fails if the selection set contains multiple disjoint sets.

I've attached a second lisp, which has (almost) nothing to do with the subject, but it uses some parts of the first one, regarding regions creation and transforming regions in polylines. Basically, it is about union polylines.
« Last Edit: March 07, 2014, 07:38:11 AM by Stefan »

Fabricio28

  • Swamp Rat
  • Posts: 631
Re: To find each closed boundary of selected object
« Reply #11 on: March 07, 2014, 07:59:35 AM »
Excellent code, Mr. Lee!
But isn't working with arcs.

Could you help me, please?

Thank in advance.
 :-D

Master_Shake

  • Swamp Rat
  • Posts: 1441
Re: To find each closed boundary of selected object
« Reply #12 on: March 07, 2014, 11:27:07 AM »
Why not just convert the ARC to a PLINE

and BPOLY a circle?

Fabricio28

  • Swamp Rat
  • Posts: 631
Re: To find each closed boundary of selected object
« Reply #13 on: March 07, 2014, 04:34:24 PM »
Stefan's code worked perfect!

Regards,

ymg

  • Swamp Rat
  • Posts: 725
Re: To find each closed boundary of selected object
« Reply #14 on: April 09, 2014, 02:21:05 PM »
stefan,

Great routines, specially like Enclosed Polylines.

ymg