TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: qjchen 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
;;; ========================================================================
;;; 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
-
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-)
-
Excellent program!I like it very much.
-
Anybody have a better way of doing this?
-
Anybody have a better way of doing this?
Try the attached program, based on a method by Stefan.
(http://lee-mac.com/swamp/bbpoly.gif)
Compatible with Lines & straight-segmented LWPolylines.
-
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.
-
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?
-
Use the boundary command to create the "boundary"......
-
nice job lee but is not working with circles ?
-
nice job lee but is not working with circles ?
"Compatible with Lines & straight-segmented LWPolylines."
-
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.
-
Excellent code, Mr. Lee!
But isn't working with arcs.
Could you help me, please?
Thank in advance.
:-D
-
Why not just convert the ARC to a PLINE
and BPOLY a circle?
-
Stefan's code worked perfect!
Regards,
-
stefan,
Great routines, specially like Enclosed Polylines.
ymg
-
stefan,
Great routines, specially like Enclosed Polylines.
ymg
Thank you, ymg.
-
Hi Stefan,
* Union Polylines.LSP
* Enclosed polylines.LSP
These routines don't work for Autocad 2008...please help me
-
Hi Stefan,
* Union Polylines.LSP
* Enclosed polylines.LSP
These routines don't work for Autocad 2008...please help me
Both works on Acad2007.
Please check if all objects are in WCS.
-
Hi, Stefan
I get " ; error: bad argument type: VLA-OBJECT #<SUBR @0ca52d34 ACDOC> " at the command line,
i use acad 2007
-
Hi, Stefan
I get " ; error: bad argument type: VLA-OBJECT #<SUBR @0ca52d34 ACDOC> " at the command line,
i use acad 2007
Change variable name acDoc in both lisp files
(defun c:UNIP ( / *error* i lst ms r1 reg ss sysvar prop)
(or *acDoc* (setq *acDoc* (vla-get-activedocument (vlax-get-acad-object))))
.......
... or make it local
(defun c:UNIP ( / *error* acDoc i lst ms r1 reg ss sysvar prop)
(setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
.......
Edit: :-D
-
Thanks alot!!!!!!!
-
You're welcome.
I've made some corrections in my previous post. You should update your files accordingly.
-
Can you help me a routine as example:
--> Select en2 (polyline) and en1 (Horizontal line), then return list entity names of boundaries 1, 2, 3 (which below Horizontal line en1)
Thanks so much!
(http://i1048.photobucket.com/albums/s362/tieptouch/EX_zps3a12f538.jpg)
-
This topic could be continued with this one :
https://www.theswamp.org/index.php?topic=49453.msg545846#msg545846
M.R.
-
Lee and Steffan thanks for the lisps
Steffan both of your lisps were exactly what i was looking for
thanks again
-
hello again
I was wondering if a little improvement could be made to the routine.
When we use this routine to make boundaries and we have two rows of boundaries to be made (one row adjacent to the other) , and lets say we have a 10x10 square box, and next to it we have 2 5x5 square boxes, so the boundary of the 10x10 square box will have an extra vertex in the middle of the adjacent line next to the two 5x5 square boxes.
Is there a way we can stop that from happenning??? it gets in the way when we want to put dimensions to the boundaries.
-
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.
hello Everyone,
thank's a lot for Stefan for his routine "Enclosed polylines.LSP" IT IS GREAT, however I encountered an error "Error: AutoCAD.Application: Invalid input".
I selected lines that are not intersected but touch each other at the beginning / end or share the same vertexes.
the same error occurs when I select lines that are far from each other in a way that is impossible to find closed polylines.
anther thing that might be irrelevant is that this routine http://www.theswamp.org/index.php?topic=10370.0#lastPost (http://www.theswamp.org/index.php?topic=10370.0#lastPost)
works with the same lines.
also the command boundary works as well.
I attached a photo of the lines.
-
hello Everyone,
thank's a lot for Stefan for his routine "Enclosed polylines.LSP" IT IS GREAT, however I encountered an error "Error: AutoCAD.Application: Invalid input".
I selected lines that are not intersected but touch each other at the beginning / end or share the same vertexes.
the same error occurs when I select lines that are far from each other in a way that is impossible to find closed polylines.
anther thing that might be irrelevant is that this routine http://www.theswamp.org/index.php?topic=10370.0#lastPost (http://www.theswamp.org/index.php?topic=10370.0#lastPost)
works with the same lines.
also the command boundary works as well.
I attached a photo of the lines.
Hello
Make sure all your lines are in the same plan, preferably WCS. Set UCS to WCS.
Check if all are starting and ending at Z=0.
Check if all ends are truly meeting.
Run OVERKILL first to be sure there are no overlapping segments.
If it fails again, post a dwg sample. I'll take a look to see what's wrong.
Good luck.
-
hello Everyone,
thank's a lot for Stefan for his routine "Enclosed polylines.LSP" IT IS GREAT, however I encountered an error "Error: AutoCAD.Application: Invalid input".
I selected lines that are not intersected but touch each other at the beginning / end or share the same vertexes.
the same error occurs when I select lines that are far from each other in a way that is impossible to find closed polylines.
anther thing that might be irrelevant is that this routine http://www.theswamp.org/index.php?topic=10370.0#lastPost (http://www.theswamp.org/index.php?topic=10370.0#lastPost)
works with the same lines.
also the command boundary works as well.
I attached a photo of the lines.
Hello
Make sure all your lines are in the same plan, preferably WCS. Set UCS to WCS.
Check if all are starting and ending at Z=0.
Check if all ends are truly meeting.
Run OVERKILL first to be sure there are no overlapping segments.
If it fails again, post a dwg sample. I'll take a look to see what's wrong.
Good luck.
Thank's a lot sir for your fast reply,
I've tried your advise with no luck unfortunately, however when I extend the lines over each other to be intersected the routine work fine "in the first one" & at the second one, I enthroned all the lines are touching each other but with no luck also.
-
- The outer limits, in layer US-SITE-RWAY, are not always closed. Isolate layer, try PEDIT - Multiple, <select all>, Join. You will see, not all the resulting polylines are closed. Fix them and then you can use the resulting polylines or you can explode them.
- After that, extend both ends of the US-SITE-LAND-PROP lines a few units, to be sure they intersect the border. In your sample, a lot of them are not exactly on the border, sometime missed by just 0.0002 units.
- Use overkill, ignoring layer, color, linetype etc.
- Process one island at the time.
Use the attached lisp.
You will still get some errors, especially in the curved islands... The tangent lines and arcs are not connected, not tangent, or fails for no particular reason, even for some Autocad native commands.
-
Dear Stefan,
THANKS A LOT for your kind concern and fast replays, I'm so grateful for your routine.
Everything works will now, after following your advise.
thanks again.