Lisp to create a boundary around blocks that are not touching.

[dollada06]

Hey everyone. Thanks in advance for your help. I am looking for a LISP. Unfortunately I do not know how to write them myself and I have looked pretty much everywhere for one and I just cannot seem to find it. What I am looking for is a lisp that will draw a polyline around a selected group of blocks. I know there is a SHRINKWRAP command that exists, but the reason I cannot make use of that is because the objects I need to create a boundary around--they're not touching.

 

Here is a quick example of what I am looking for:

 

CADTutor LISP Example.dwg

 

If this feature exists in CAD I apologize for wasting anyone's time, but I have looked all over the place and just cannot seem to find what I am looking for.

 

This is something I have to do 100's of times in a drawing and the outline is different every single time. So a LISP seems like the fastest way for me to do this, but unfortunately I just do not know how to write them so I am asking for anyone's help who is willing to.

 

Thank you all for your help again. It is much appreciated!

[BIGAL]

An idea is pick objects pick a centroid pt then some how raytrace all the points into a list and work out wether next is within the new outer shape. An arc/circle would need facets like shrinkwrap does now. I would expect this exists somewhere.

[BIGAL]

Why did I not look at the right place first http://www.lee-mac.com he has a Convex hull routine that uses the method suggested which is to do with comparing next point in a direction.

 

You will need points for it to work in the case of the blocks a bounding box routine needs to be run first creating a list of points.

[Lee Mac]

I have the following, but there are still some bugs -

 

[BIGAL]

I did a lot of googling and there is a solution at Mathlab that gives a second order soultion a more closely defined shape joining points but it does have a cost.

 

Found a couple of others but again at cost. there was one site but had to join to get the code www.github.com

[marko_ribar]

I also did some code, but my version strictly is doing rectangles in circular path - if there is central one it's also calculated giving bad result, and beside this it's also little buggy...

[BIGAL]

Nice one guys but look at my image it closer to a true shape desired joining end points, as I said I spent around 2 hours researching this and there are algorithms out there the github was real close even coding in common LISP that would provide a starting point for Autolisp, then I lost the page and now can not find. I may join Github to find an answer. They work on random points not shapes. This is the similar approach to tracing images. There is a huge wealth of information on the theory but not actual code, some examples are there in c# etc. There is a 1st order solution then a more advanced 2nd order which is like what I have posted.

 

There appears to be two solutions a random 1 my image or a more ortho answer by Lee & Marko what does the poster want ?

[marko_ribar]

I can't post my code as it don't satisfy OP's request, though I've corrected it further more to overcome bugs, but still it can't work sometimes where rectangle(s) is(are) in center of surrounding of other rectangles... Maybe the most intelligent is something that BIGAL suggested, although I didn't dive into it; I was just writing my version for personal purposes and to see if I can do it as Lee did in his animation...

[ronjonp]

Give this a try .. seemed to work OK on your example drawing.

(defun c:uunion	(/ _off b e off reg regions s s2 sp tmp x)
 ;; RJP 09.18.2017
 ;; UGLY effin code, but works on sample drawing .. can it be broken? But of course ;-)
 (defun _off (o d f / out tmp)
   (foreach di	(list d (- d))
     (if
(not (vl-catch-all-error-p (setq tmp (vl-catch-all-apply 'vlax-invoke (list o 'offset di))))
)
 (setq out (cons (car tmp) out))
     )
   )
   (cond ((= 2 (length out))
   (setq out (vl-sort out '(lambda (a b) (f (vla-get-area a) (vla-get-area b)))))
   (vla-delete (cadr out))
   (car out)
  )
  (car out)
   )
 )
 (or (setq off (getdist "\nPick distance to check < 15 >: ")) (setq off 15))
 (if
   (and (setq sp (vlax-get (vla-get-activedocument (vlax-get-acad-object))
		    (if	(= (getvar 'cvport) 1)
		      'paperspace
		      'modelspace
		    )
	  )
 )
 (setq s (ssget ":L" '((0 . "insert"))))
 (setq s (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))
 (setq s (mapcar '(lambda (x) (car (vlax-invoke x 'explode))) s))
 (setq s2 (mapcar '(lambda (x) (car (_off x off >))) s))
 (setq regions (vlax-invoke sp 'addregion s2))
   )
    (progn (mapcar 'vla-delete s)
    (mapcar 'vla-delete s2)
    (foreach reg regions
      (mapcar (function (lambda (x) (vl-catch-all-apply 'vla-boolean (list reg acunion x))))
	      (vl-remove reg regions)
      )
    )
    (setq b (vlax-ename->vla-object (setq e (entlast))))
    (entmod (subst '(8 . "RJP_Outline") (assoc 8 (entget e)) (entget e)))
    (vlax-invoke b 'explode)
    (if	(setq s (ssget "_x" '((0 . "line,arc,lwpolyline") (8 . "RJP_Outline"))))
      (if (= 1 (getvar 'peditaccept))
	(command "_.pedit" "Multiple" s "" "Join" 0.0 "")
	(command "_.pedit" "Multiple" s "" "y" "Join" 0.0 "")
      )
    )
    (vla-delete b)
    (setq b (vlax-ename->vla-object (entlast)))
    (_off b off <)
    (vla-delete b)
    )
 )
 (princ)
)
(vl-load-com)

Edited September 19, 2017 by ronjonp

[Lee Mac]

Interesting solution Ron

[lrm]

The program does not appear to work correctly if one of the boxes is moved more than 15 units away from the other boxes. For example, move one of the extreme left boxes 50 to the left and it will have a separate outline. I think the OP should clarify the use of a tolerance as to when to make a jump to the next box and when not to.

 

In trying to establish a set of rules that could be programmed to create the outline it appears that more information is needed. For example, assume that the program is walking around the drawing in a clockwise direction trying to define the outline and it gets to point A. From here the next point could be point B to the right or down to C. You have set a rule that says to move on to point B. Okay, now that we are at B should the next point be at D or E. Following the precedent that was set at A the next point after B should be E not D. What is the rationale for choosing D over E? That it is too far away? What is too far? What is the logic for choosing E instead of D?

[ronjonp]

Interesting solution Ron

 

Thanks Lee

[ronjonp]

The program does not appear to work correctly if one of the boxes is moved more than 15 units away from the other boxes.

...

...

[ATTACH=CONFIG]62209[/ATTACH]

The program was written as more of an approach on how this could be accomplished and worked with the OP's test drawing. If you need a larger tolerance, change the OFF variable to something larger or prompt for user input:

(or (setq off (getdist "\nPick distance to check: ")) (setq off 15))

[lrm]

The program was written as more of an approach on how this could be accomplished and worked with the OP's test drawing. If you need a larger tolerance, change the OFF variable ...[/code]

 

Of course the offset can be changed and if the program meets the OP's needs than that is all that is required. It is an impressive program. I did find that in certain situations the program aborts when it tries to use pedit y to create the final polyline outline. The result is an offset region. I think the situation is related to isolated islands positioned more than the offset away from the rest of the blocks.

 

Here's an example:

Command: UUNION

Select objects: Specify opposite corner: 6 found

Select objects:

_.pedit

Select polyline or [Multiple]: Multiple

Select objects: 5 found

Select objects:

Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]: y

Invalid option keyword.

; error: Function cancelled

Enter an option [Close/Open/Join/Width/Fit/Spline/Decurve/Ltype gen/Reverse/Undo]:

 

[ronjonp]

Yup .. you have to make sure that the distance is large enough that it captures all objects. There are multiple ways to break the code .. but it's a start

Edited September 19, 2017 by ronjonp

[marko_ribar]

Hi Ron, I think you are now looking too much things from a perspective of your offset solution... I removed bugs from version I created and I can confirm that with good sub functions background you can get desired outline lwpolyline almost exactly correct as OP wanted... Of course firstly you have to have patience to create main code and then you just add appropriate subs to remove possible bugs like I showed in my gif - rectangle a little displaced toward center of surroundings which is completely outlined... Subs I used are somewhat copyrighted material but they are available - Lee's LM:outline selection of entities, LM:selsetboundingbox, Gilles's clean_poly, my simplify_poly and that's all... But the base is main code (firstly you have to collect all rectangles enames with their points always in direction lower left, lower right, upper right, upper left and store this data in appropriate main list; then you basically have to extract only points and use as base lowest point of all with simple sorting : (car (vl-sort pl (function (lambda ( a b ) (if (equal (cadr a) (cadr b) 1e-6) (

After all debugging and getting result as shown in my gif, you finally apply those sub functions after lw is created :

...

(if lw

(simplify_poly (ssname (LM:outline (ssadd (clean_poly lw))) 0))

)

(entdel lw)

(*error* nil)

); end of routine

[ronjonp]

Hi Ron, I think you are now looking too much things from a perspective of your offset solution... I removed bugs from version I created and I can confirm that with good sub functions background you can get desired outline lwpolyline almost exactly correct as OP wanted... Of course firstly you have to have patience to create main code and then you just add appropriate subs to remove possible bugs like I showed in my gif - rectangle a little displaced toward center of surroundings which is completely outlined... Subs I used are somewhat copyrighted material but they are available - Lee's LM:outline selection of entities, LM:selsetboundingbox, Gilles's clean_poly, my simplify_poly and that's all... But the base is main code (firstly you have to collect all rectangles enames with their points always in direction lower left, lower right, upper right, upper left and store this data in appropriate main list; then you basically have to extract only points and use as base lowest point of all with simple sorting : (car (vl-sort pl (function (lambda ( a b ) (if (equal (cadr a) (cadr b) 1e-6) (

After all debugging and getting result as shown in my gif, you finally apply those sub functions after lw is created :

...

(if lw

(simplify_poly (ssname (LM:outline (ssadd (clean_poly lw))) 0))

)

(entdel lw)

(*error* nil)

); end of routine

 

Marko,

 

The offset solution is merely another way to accomplish the task and I wrote it for fun .. I'd be interested to see your mathematical solution.

[marko_ribar]

Marko,

 

The offset solution is merely another way to accomplish the task and I wrote it for fun .. I'd be interested to see your mathematical solution.

 

Look Ron, Lee Mac would react on me if I'd to post my version like I said because of copyright, but if you send me an email I could post it to you with one condition and that is that you don't post the code...

My mail as you know : ribarm@gmail.com

[Lee Mac]

Look Ron, Lee Mac would react on me if I'd to post my version like I said because of copyright...

 

I'm not sure where you're getting that idea from...

Providing that you adhere to my general terms (specifically, retention of headers/noted modifcations/no distribution fees), I have no problem at all with you posting code which uses my functions...

[BIGAL]

Something to try is Make a triangular network then use shrinkwrap this will make a shape around the outside of the 3d faces, tested on sample and worked 1st go. There is triangulation via lisp here at Cadtutor.

 

BUT ! needed to trim long triangles which is a function that can be written exists in something we have but not autocad.

 

The example dwg is from CIV3D so can do right now no code required. If you have civ3d. Worked with surface triangles then used delete edge in CIV3d. The only hiccup is had to explode the objects a of times as I used import LINES to create surface even though every point is Z=0.0 Using points would yield the same answer after running say bounding box for blocks.

 

There is some examples out there though when goggling that showed me the idea but no code.

Edited September 20, 2017 by BIGAL