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
Solved! Go to Solution.
Solved by dlanorh. Go to Solution.
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
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
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
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
@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, 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.
I am not one of the robots you're looking for
@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.
loving your work!!
but I "just" found out BMIP doesn't work if Linetype Generation is Enabled.
@Robert_GibsonT7SPQ 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)))
Can't find what you're looking for? Ask the community or share your knowledge.