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

September 21, 2017

Dear All,

I used Ron's code and it works flawlessly on the test drawing that I made. Unfortunately, and it is my fault, I didn't really consider a few things that seems to be causing problems.

1) The blocks that we use are not just a simple block. I had to strip stuff out from inside of them due to protecting company private stuff. We have some geometry inside of those blocks which seems to be causing problems. What it does when we have our actual blocks being used is it freaks out and does something like this:

https://imgur.com/a/u3H7C

What is happening is it outlines every block and then does this strange bounding box like thing.

Could we maybe specify in the LISP to ONLY check certain layers and ignore everything else? I don't know much about LISP so if I am asking to move heaven and earth please tell me to go fly a kite.

2) The second issue I am seeing is when we have an opening inside of an array of blocks like in the example below. Ron's source code does an offset and then brings it back to the edges which is fantastic, but the issue is if we have a shorter block inside it will not offset the outer most line that was generated. I'm not sure if there is a way to intelligently tell it to ignore a gap like that. The line being drawn is really not an issue. I can always delete it. But is there a way to always offset that outer line back to the very edge?

https://imgur.com/a/JAAfp

I also want to take a moment to thank all of you again for your help. I know I am asking a lot. I appreciate it a lot! If any of you are going to Autodesk University let me know. I owe you a beer or 2!

September 21, 2017

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

Cost is not really a concern for me as long as it is not outrageous and there is an ability to test it in some capacity before using it. Could you link to it? I am not sure if that breaks any rules of the site or not.

September 21, 2017

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 ?

Hey BIGAL,

I am not knowledgeable enough on the subject to have a reasonable opinion of one way over the other I will be honest. This thread has really made me look into learning LISP and AutoLISP though.

I am completely open to all approaches for this. This is seems like a great discussion on how to tackle my issue though. Hopefully people are getting a lot of good information from one another in here. I really appreciate all the help a ton. You guys are awesome!

March 6, 2020

On 9/18/2017 at 11:30 PM, ronjonp said:

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)

Hi Ron,

Your lisp is just i was looking for as i guess.But it seems does not work on Autocad 2019 and Autocad Civil 3D 2019 Versions.I have a bunch of points to have boundary arround.When i run the lisp, it does not select any objects at all.Please check the attached video and dwg file.Thank you in advance.

umit

Autodesk Civil 3D 2019 - [Drawing1.dwg] 2020-03-06 17-46-05.rar points.dwg

March 6, 2020

It is supposed to be working with geometry like blocks (INSERT) with curve geometry, not with points like you showed in your video... I am afraid that there is no algorithm that would do what you want to achieve... You could try though to make TIN surface and remove convex triangles manually... Finally you should create regions from triangles that are making boundary you want to keep, and union them to remove common edges after which you should explode boundary region and join boundary into final polyline...

March 7, 2020

"convex triangles manually" known as remove long triangles very handy when grid type points are involved, CIV3D has delete a triangle it actually does not delete rather does not display.But then you can export triangles and try code. LineworkShrinkwrap should now work.

March 7, 2020

Hi,

I also have the code in the link below ( Example Program 1) which belongs to Lee Mac.It seems working with points but it does not have a distance (cleareance) option that i certainly need.

http://www.lee-mac.com/convexhull.html

And also it does not work on my machine and gives the following error.

Command: test1
Select objects: Specify opposite corner: 1977 found
Select objects:
; error: no function definition: LM:CONVEXHULL
Command:

Thank you

Umit

March 7, 2020

4 hours ago, folderdash said:

http://www.lee-mac.com/convexhull.html

And also it does not work on my machine and gives the following error.

Command: test1
Select objects: Specify opposite corner: 1977 found
Select objects:
; error: no function definition: LM:CONVEXHULL
Command:

You need to download & load the LM:ConvexHull function from the link at the top of the page.

Edited March 7, 2020 by Lee Mac

March 13, 2020

Thank you very much guys.

January 14, 2021

On 9/18/2017 at 3:30 PM, ronjonp said:

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)

hi ronjop, i try use this code, but i can´t get that the progran catch the object, i try to do with rectangle in another time with blockhi ronjop, i tried use this code, but i can´t get that the program catch the object, i tried to to with rectangle in another time with block. can you help me?

January 14, 2021

12 hours ago, aaron.gonzalez said:

Post a sample drawing.

January 29, 2021

On 9/19/2017 at 4:30 AM, ronjonp said:

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)

am getting this error :


Command: UUNION
Pick distance to check < 15 >:
Select objects: Specify opposite corner: 6 found

Select objects:
Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.

January 29, 2021

Like the recommendation above, try changing the two command calls to command-s.

February 1, 2021

On 1/30/2021 at 3:31 AM, ronjonp said:

Like the recommendation above, try changing the two command calls to command-s.

so from

command "_.pedit" "Multiple" s "" "Join" 0.0

will become?

command-s "_.pedit" "Multiple" s "" "Join" 0.0

February 1, 2021

2 hours ago, CAD_Noob said:
so from
command "_.pedit" "Multiple" s "" "Join" 0.0
will become?
command-s "_.pedit" "Multiple" s "" "Join" 0.0

Like this:

(if (= 1 (getvar 'peditaccept))
  (command-s "_.pedit" "Multiple" s "" "Join" 0.0 "")
  (command-s "_.pedit" "Multiple" s "" "y" "Join" 0.0 "")
)

February 2, 2021

13 hours ago, ronjonp said:

Like this:


(if (= 1 (getvar 'peditaccept))
  (command-s "_.pedit" "Multiple" s "" "Join" 0.0 "")
  (command-s "_.pedit" "Multiple" s "" "y" "Join" 0.0 "")
)

Thanks so much Ron...working fine now.

February 2, 2021

Glad to help.

October 29, 2021

On 9/17/2017 at 7:24 AM, Lee Mac said:

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

Lee, i couldn't found the code at lee-mac.com . Found only The outlineobjects command that works only with touching objects.

Can you post the code that works as the gif?

And thanks for your material at the site, I found a lot of good information about lisp coding there.

Best regards

October 29, 2021

6 minutes ago, mrigorh said:

Lee, i couldn't found the code at lee-mac.com . Found only The outlineobjects command that works only with touching objects.

Can you post the code that works as the gif?

And thanks for your material at the site, I found a lot of good information about lisp coding there.

Best regards

Never mind, just found it. Thanks!

October 29, 2021

7 hours ago, mrigorh said:

Never mind, just found it. Thanks!

I don't think I ever shared this code to the forums as I never got around to ironing out all of the bugs...

Sign In

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

Recommended Posts

dollada06

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

exceed

Lee Mac

marko_ribar

Posted Images

dollada06

dollada06

folderdash

marko_ribar

BIGAL

folderdash

Lee Mac

folderdash

aaron.gonzalez

ronjonp

CAD_Noob

ronjonp

CAD_Noob

ronjonp

CAD_Noob

ronjonp

mrigorh

mrigorh

Lee Mac

Join the conversation

exceed

Lee Mac

marko_ribar

Tutorials

Forums

Activity