Lisp to Insert block to inside of selected closed polygons

Anonymous · ‎09-04-2019

Hi All,

I'm looking for lisp to insert a block to all selected closed polygons. The block should sit inside polygons not at the centroid as the centroid may fall sometimes outside of the polygons. Please refer to the attached screen shot for clarity.

Appreciate your help.

Regards

Jaleel

dlanorh · ‎09-05-2019

Try this.

;; by Gilles Chanteau (_gile)
(defun gc:MostInnerPoint (obj fuzz / 2d-coord->pt-lst 3d-coord->pt-lst dich-sub len tmp)

  (defun 2d-coord->pt-lst (lst)
    (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst))))
  );end_defun

  (defun 3d-coord->pt-lst (lst)
    (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (3d-coord->pt-lst (cdddr lst))))
  );end_defun

  (defun dich-sub (inf sup / of new pts)
    (if (equal inf sup fuzz)
      (progn
        (setq of  (vlax-invoke obj 'Offset inf)
              pts (if (= (vla-get-ObjectName (car of)) "AcDbPolyline")
                    (2d-coord->pt-lst (vlax-get (car of) 'Coordinates))
                    (3d-coord->pt-lst (vlax-get (car of) 'ControlPoints))
                  );end_if
        );end_setq
        (mapcar 'vla-delete of)
        (mapcar (function (lambda (x) (/ x (length pts)))) (apply 'mapcar (cons '+ pts)))
      );end_progn
      (progn
        (setq new (/ (+ inf sup) 2.0)
              of  (vl-catch-all-apply 'vlax-invoke (list obj 'Offset new))
        );end_setq
        (if (vl-catch-all-error-p of)
          (dich-sub inf new)
          (progn
            (mapcar 'vla-delete of)
            (dich-sub new sup)
          )
        );end_if
      );end_progn
    );end_if
  );end_defun

  (if (and  (member (vla-get-ObjectName obj) '("AcDbPolyline" "AcDbSpline"))
            (vlax-curve-isClosed obj)
            (or (= (vla-get-ObjectName obj) "AcDbPolyline")
                (vlax-curve-isPlanar obj)
            );end_or
            (setq tmp (vl-catch-all-apply 'vlax-invoke (list obj 'Offset fuzz)))
            (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
                  tmp (car tmp)
            );end_setq
            (if (< len (vlax-curve-getDistAtParam tmp (vlax-curve-getEndParam tmp)))
              (setq len (/ len (* -2 pi)))
              (setq len (/ len (* 2 pi)))
            );end_if
            (not (vla-delete tmp))
      );end_and
      (dich-sub 0.0 len)
  );end_if
);end_defun (MostInnerPoint)

(vl-load-com)

(defun c:bmip ( / *error* c_doc c_spc sv_lst sv_vals blk bname ss l_obj i_pt n_obj)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred")))
    (princ)
  );end_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block to Insert : ")))
        bname (vlax-get blk 'name)
        ss (ssget '((0 . "LWPOLYLINE") (70 . 1)))
  );end_setq

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq l_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
                  i_pt (gc:MostInnerPoint l_obj 0.001)
                  n_obj (vla-InsertBlock c_spc (vlax-3d-point i_pt)t bname 1 1 1 0)
            )
            (vlax-put-property n_obj 'layer (vlax-get-property blk 'layer))
          );end_repeat
        )
        (t (alert "No Polylines Selected"))
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

I am not one of the robots you're looking for

dlanorh · ‎09-05-2019

Just noticed a spurious letter in the code. Try the attached

;; by Gilles Chanteau (_gile)
(defun gc:MostInnerPoint (obj fuzz / 2d-coord->pt-lst 3d-coord->pt-lst dich-sub len tmp)

  (defun 2d-coord->pt-lst (lst)
    (if lst (cons (list (car lst) (cadr lst)) (2d-coord->pt-lst (cddr lst))))
  );end_defun

  (defun 3d-coord->pt-lst (lst)
    (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (3d-coord->pt-lst (cdddr lst))))
  );end_defun

  (defun dich-sub (inf sup / of new pts)
    (if (equal inf sup fuzz)
      (progn
        (setq of  (vlax-invoke obj 'Offset inf)
              pts (if (= (vla-get-ObjectName (car of)) "AcDbPolyline")
                    (2d-coord->pt-lst (vlax-get (car of) 'Coordinates))
                    (3d-coord->pt-lst (vlax-get (car of) 'ControlPoints))
                  );end_if
        );end_setq
        (mapcar 'vla-delete of)
        (mapcar (function (lambda (x) (/ x (length pts)))) (apply 'mapcar (cons '+ pts)))
      );end_progn
      (progn
        (setq new (/ (+ inf sup) 2.0)
              of  (vl-catch-all-apply 'vlax-invoke (list obj 'Offset new))
        );end_setq
        (if (vl-catch-all-error-p of)
          (dich-sub inf new)
          (progn
            (mapcar 'vla-delete of)
            (dich-sub new sup)
          )
        );end_if
      );end_progn
    );end_if
  );end_defun

  (if (and  (member (vla-get-ObjectName obj) '("AcDbPolyline" "AcDbSpline"))
            (vlax-curve-isClosed obj)
            (or (= (vla-get-ObjectName obj) "AcDbPolyline")
                (vlax-curve-isPlanar obj)
            );end_or
            (setq tmp (vl-catch-all-apply 'vlax-invoke (list obj 'Offset fuzz)))
            (setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
                  tmp (car tmp)
            );end_setq
            (if (< len (vlax-curve-getDistAtParam tmp (vlax-curve-getEndParam tmp)))
              (setq len (/ len (* -2 pi)))
              (setq len (/ len (* 2 pi)))
            );end_if
            (not (vla-delete tmp))
      );end_and
      (dich-sub 0.0 len)
  );end_if
);end_defun (MostInnerPoint)

(vl-load-com)

(defun c:bmip ( / *error* c_doc c_spc sv_lst sv_vals blk bname ss l_obj i_pt n_obj)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred")))
    (princ)
  );end_defun

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
        sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (setq blk (vlax-ename->vla-object (car (entsel "\nSelect Block to Insert : ")))
        bname (vlax-get blk 'name)
        ss (ssget '((0 . "LWPOLYLINE") (70 . 1)))
  );end_setq

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq l_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))
                  i_pt (gc:MostInnerPoint l_obj 0.001)
                  n_obj (vla-InsertBlock c_spc (vlax-3d-point i_pt) bname 1 1 1 0)
            )
            (vlax-put-property n_obj 'layer (vlax-get-property blk 'layer))
          );end_repeat
        )
        (t (alert "No Polylines Selected"))
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

I am not one of the robots you're looking for

Anonymous · ‎09-08-2019

Thanks @dlanorh

I tried running this script. It inserted blocks to about 50% of the total blocks selected. Then stopped. I have uploaded the result .dwg file. Could you please try to fix this?

Kidn Regards

Jaleel

dlanorh · ‎09-08-2019

Sorry but I cannot open that drawing, it is in a later version than the one I am running. Can you save as in AutoCad2010 format and resend. Thanks

I am not one of the robots you're looking for

Anonymous · ‎09-08-2019

Sorry, I have uploaded the same in 2010 format.

Regards

Jaleel

dlanorh · ‎09-08-2019

Don't worry about the drawing format, you weren't to know.

I've decreased the sensitivity passed to the innermost point function by a factor of 10. It now seems to work without erroring. The problem was inside this function, and the decrease seems to have solved the problem.

Be aware you have a lot of irregular shaped polylines that could also cause problems because of the method used to find the point (offsets). It might also be wise to not process the whole set at once. This set was nearly 3000 polylines. Decreasing the sensitivity further may speed the process up but at a cost of a less accurate point

This is where to change it. The red figure was initially 0.001 and is now working properly at 0.01

i_pt (gc:MostInnerPoint l_obj 0.01)

When you said block I didn't envision a block with a single attribute. The current routine is inserting a new block so the attribute displays the default attribute value. Is the routine supposed to copy the original block as opposed to inserting a new one? This should be easy to to impliment if so.

Attached is the updated lisp.

I am not one of the robots you're looking for

Anonymous · ‎09-08-2019

Thanks, @dlanorh for your help and support. This works Perfect! This will save a significant amount of our time to do this routine task!

Regards

Jaleel

dlanorh · ‎09-09-2019

@AnonymousGlad I could help. Did you want the block as it is inserting it (default attribute value) or did you want it to have the value of the selected block?

I am not one of the robots you're looking for

Anonymous · ‎09-09-2019

Dear @dlanorh, It doesn't matter really. In my case most of the attribute values are the same. So I can select all blocks after insertion and change the values from the properties one time.

Regards

Jaleel

dlanorh · ‎09-10-2019

OK. 👍

I am not one of the robots you're looking for

Anonymous · ‎02-29-2020

thanks @dlanorh works like charm... and question is @Anonymous @dlanorh is there any lisp routine to place attribute blocks on polylines.

Anonymous · ‎03-01-2020

@Anonymous, please use the attached lisp. Please note that you need to edit the lisp to amend the block name to be loaded on polyline. Please refer to the attached snap shot for details.

Anonymous · ‎03-01-2020

@Anonymous thanks alot.

Anonymous · ‎03-02-2020

@Anonymous

@dlanorh

i am having 1 issue with this.. i place blocks at end point.. can you please edit it to place block and mid or somewhere not in the end please❗

dlanorh · ‎03-02-2020

The lisp is not designed to place a block at the end of anything, but in the middle of a closed polyline.

I am not one of the robots you're looking for

Kent1Cooper · ‎03-02-2020

@Anonymous wrote:

.... i place blocks at end point.. can you please edit it to place block and [at?] mid or somewhere not in the end please

If I understand correctly, you don't need a custom routine for that. The DIVIDE command will put a Block at the midpoint of anything you like, using the Block option and DIVIDE-ing into 2 segments.

Kent Cooper, AIA

_anonandon · ‎04-29-2024

loving your work!!

but I "just" found out BMIP doesn't work if Linetype Generation is Enabled.

Kent1Cooper · ‎04-29-2024

@_anonandon wrote:
.... but I "just" found out BMIP doesn't work if Linetype Generation is Enabled.

That's because of this:

ss (ssget '((0 . "LWPOLYLINE") (70 . 1)))

To "see" them with and without linetype generation enabled, replace that with:

ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1)))

Kent Cooper, AIA

_anonandon · ‎04-29-2024

Mr Cooper!

legend

I wasnt expecting a fix! but thanks for the info

Community

Lisp to Insert block to inside of selected closed polygons

Lisp to Insert block to inside of selected closed polygons

Lisp to Insert block to inside of selected closed polygons