Lisp to insert blocks on Polylines

Anonymous · ‎09-04-2019

I'm looking for a lisp that can insert an attributed text block to polylines. Following are the conditions

a) Only one block shall be inserted to a polyline irrespective of its length

b) Block shall be inserted/snapped perfectly to anyone node along polyline

c) Blocks shall be inserted to multiple polylines in one go

I appreciate any help on this.

Regards

Jaleel

dlanorh · ‎09-04-2019

@Anonymous wrote:
I'm looking for a lisp that can insert an attributed text block to polylines. Following are the conditions

a) Only one block shall be inserted to a polyline irrespective of its length
b) Block shall be inserted/snapped perfectly to anyone node along polyline
c) Blocks shall be inserted to multiple polylines in one go

I appreciate any help on this.

Regards
Jaleel

1. What block? Upload a sample dwg containing the block

2. Polylines don't have nodes, they have vertices and segments. In multi vertex/segmented polylines, how do you decide which vertex/segment to choose when you are selecting via a selection set (i.e. default)?

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

CodeDing · ‎09-04-2019

@Anonymous ,

dlanorh is correct, the context of your request is very vague. More information is needed to assist you in a better way.

Without any more information, here is a sample of exactly what you are requesting (you need to change "MyBlockName" to your actual block name).

(defun c:BOP ( / ss osm cnt e)
;Block On Polyline
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (progn
    (setq osm (getvar 'OSMODE)) (setvar 'OSMODE (logior 16384 osm))
    (setvar 'CMDECHO 0)
    (repeat (setq cnt (sslength ss))
      (setq e (entget (ssname ss (setq cnt (1- cnt)))))
      (command "-INSERT" "MyBlockName" "_scale" 1 "_none" (cdr (assoc 10 e)) 0)
    );repeat
    (setvar 'OSMODE osm)
    (setvar 'CMDECHO 1)
  );progn
;else
  (prompt "\n...no LWPOLYLINES found.")
);if
(prompt "\nBOP Complete.")
(princ)
);defun

Best,

~DD

Anonymous · ‎09-04-2019

Sorry for the confusion and thanks for this lisp.

This lisp works well, but only problem is it inserts block on endpoint. I need this to insert in any one of the middle vertice of polyline. In this case, all polylines have at least one middle vertice. Please refer to the attached screenshot for clarity. Appreciate if you can tweak the lisp to cater this specific need.

Thanks Jaleel

Kent1Cooper · ‎09-05-2019

@Anonymous wrote:

.... I need this to insert in any one of the middle vertice of polyline. ….

Try replacing this:

(command "-INSERT" "MyBlockName" "_scale" 1 "_none" (cdr (assoc 10 e)) 0)

with this:

(command "_.INSERT"

"MyBlockName" "_scale" 1

"_none"

(vlax-curve-getPointAtParam e (fix (/ (vlax-curve-getEndParam e) 2)))

0

)

Kent Cooper, AIA

Kent1Cooper · ‎09-05-2019

@Kent1Cooper wrote:
Try replacing this:

....

... and you may need to add this at the top or bottom of the file:

(vl-load-com)

Kent Cooper, AIA

dlanorh · ‎09-05-2019

My attempt now i have more info. This will insert the block an the vertex closest to the mid point of the polyline. You will need to substitute the correct block name for "your block name".

(defun c:b2pl ( / *error* c_doc c_spc sv_lst sv_vals blk ss cnt l_obj len m_pt f_p d1 d2 i_pt)

  (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 "YOUR BLOCK NAME"
        ss (ssget '((0 . "LWPOLYLINE")))
  );end_setq

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq l_obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt)))))
                  len (vlax-get-property l_obj 'length)
                  m_pt (vlax-curve-getpointatdist ent (/ len 2.0))
                  f_p (fix (vlax-curve-getparamatpoint ent m_pt))
                  d1 (vlax-curve-getpointatparam ent f_p)
                  d2 (vlax-curve-getpointatparam ent (1+ f_p))
            )
            (if (> (distance d1 m_pt) (distance m_pt d2)) (setq i_pt d2) (setq i_pt d1))
            (setq n_obj (vla-InsertBlock c_spc (vlax-3d-point i_pt) blk 1 1 1 0))
          );end_repeat
        )
        (t (alert "No Polylines Selected"))
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun
(vl-load-com)

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

Kent1Cooper · ‎09-05-2019

My suggestion in Message 5 will give you the middle vertex [or one of the two] in terms of the quantity of vertices, which admittedly in some Polylines could be far from the middle of the overall length -- that's what Message 7 is designed to give you.

Just as a suggestion, a simpler way to do this much:

....
            (setq l_obj (vlax-ename->vla-object (setq ent (ssname ss (setq cnt (1- cnt)))))
                  len (vlax-get-property l_obj 'length)
                  m_pt (vlax-curve-getpointatdist ent (/ len 2.0))
                  f_p (fix (vlax-curve-getparamatpoint ent m_pt))
                  d1 (vlax-curve-getpointatparam ent f_p)
                  d2 (vlax-curve-getpointatparam ent (1+ f_p))
            )
            (if (> (distance d1 m_pt) (distance m_pt d2)) (setq i_pt d2) (setq i_pt d1))
....

would be like this, getting the length by a way that doesn't require conversion to a VLA object [used for no other purpose], and using a common round-up-or-down approach [add 1/2 and (fix) the result downward], thereby eliminating the need for the l_obj, d1 and d2 variables and that (if) test:

....
    (setq
      ent (ssname ss (setq cnt (1- cnt)))
      len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
      m_pt (vlax-curve-getpointatdist ent (/ len 2)); 2 can be an integer, since len will be real
      i_pt (vlax-curve-getPointAtParam ent (fix (+ (vlax-curve-getparamatpoint ent m_pt) 0.5)))
    )
....

You could even eliminate the len and m_pt variables, too [they're used only once each, so you can instead just put their definitions in those places directly]:

....
    (setq
      ent (ssname ss (setq cnt (1- cnt)))
      i_pt (vlax-curve-getPointAtParam ent (fix (+ (vlax-curve-getparamatpoint ent (vlax-curve-getpointatdist ent (/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) 2))) 0.5)))
    ); setq
....

Or, to break that long line down to see the relationships:

....
    (setq
      ent
      (ssname ss (setq cnt (1- cnt)))
      i_pt
      (vlax-curve-getPointAtParam ent
        (fix
          (+
            (vlax-curve-getparamatpoint ent
              (vlax-curve-getpointatdist ent ; what was m_pt
                (/ (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) 2); what was len
              ); ...PointAtDist
            ); ...ParamAtPoint
            0.5
          ); +
        ); fix
      ); ...PointAtParam
    ); setq
....

Kent Cooper, AIA

dlanorh · ‎09-05-2019

Sorry Kent, I just replied to the first post, and didn't re-read the thread.

I'm in total agreement, but I remember that when I started to learn, this kind of coding obfuscated what was happening and was unintelligible. I try (not always successfully) to avoid this.

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

ronjonp · ‎09-05-2019

To add to Kent's excellent critique, none of this is needed either:

(setq sv_lst  (list 'cmdecho 'osmode)
      sv_vals (mapcar 'getvar sv_lst)
)
;; ...
(mapcar 'setvar sv_lst '(0 0))
;; ...
(mapcar 'setvar sv_lst sv_vals)

Anonymous · ‎09-08-2019

Thank you all for your support. Above lisp I marked as solution worked perfectly in my case.

Thanks again.

Regards

Jaleel

Anonymous · ‎03-02-2020

@dlanorh

@Anonymous

@Kent1Cooper

blocks at Polyline. it always place block at end ok lines. can you please fix it to place it in mid.

thanks and best regards

dlanorh · ‎03-03-2020

Are you after something like this? It places a block at the mid point of an arc, line, polyline or spline

(defun c:bam ( / *error* c_doc c_spc sv_lst sv_vals blk sca ss cnt ent m_dst m_pt r_ang 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_*error*_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 'osmode 'cmdecho)
        sv_vals (mapcar 'getvar sv_lst)
        blk "ARBLOCK"                   ;;BLOCK NAME TO INSERT
        sca 1                           ;;BLOCK SCALE
  );end_setq

  (mapcar 'setvar sv_lst '(0 0))

  (prompt "\nSelect Lines : ")
  (setq ss (ssget '((0 . "ARC,LINE,LWPOLYLINE,POLYLINE,SPLINE"))))
  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  m_dst (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2)
                  m_pt (vlax-curve-getpointatdist ent m_dst)
                  r_ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent m_pt)))
                  n_obj (vlax-invoke c_spc 'insertblock m_pt blk sca sca sca r_ang)
            );end_setq
          );end_repeat
        )
  );end_cond
  (mapcar 'setvar sv_lst sv_vals)
  (princ)
);end_defun

It is difficult to understand exactly what you require. Perhaps attach a sample drawing showing before and after.

I don't know the name of the block you want to insert, so you will have to change the commented line and insert the correct block name.

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

Kent1Cooper · ‎03-03-2020

@Anonymous wrote:

blocks at Polyline. it always place block at end ok lines. can you please fix it to place it in mid.

....

Will DIVIDE not do that for you? Use the Block option, Divide into 2 segments. No routine required.

Kent Cooper, AIA

Anonymous · ‎03-04-2020

@dlanorh works very fine.. thats what i need.

thanks

ronjonp · ‎03-04-2020

@dlanorh FWIW my 2c to add a bit of input error checking and removing unnecessary code:

(defun c:bam (/ blk cnt c_spc ent m_dst m_pt n_obj r_ang sca ss)
  ;; Check that we have the block to insert
  (if (tblobjname "block" (setq blk "arblock"))
    (progn (setq c_spc (vlax-get-property
			 (vla-get-activedocument (vlax-get-acad-object))
			 (if (= 1 (getvar 'cvport))
			   'paperspace
			   'modelspace
			 )
		       )
		 sca   1.		; < - Block scale
	   )
	   (prompt "\nSelect ARC,LINE,*POLYLINE,SPLINE: ")
	   ;; Check for selection or (sslength nil) below will bomb
	   (if (setq ss (ssget '((0 . "ARC,LINE,*POLYLINE,SPLINE"))))
	     (repeat (setq cnt (sslength ss))
	       (setq ent   (ssname ss (setq cnt (1- cnt)))
		     m_dst (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) 2)
		     m_pt  (vlax-curve-getpointatdist ent m_dst)
		     r_ang (angle '(0. 0. 0.)
				  (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent m_pt))
			   )
		     n_obj (vlax-invoke c_spc 'insertblock m_pt blk sca sca sca r_ang)
	       )
	     )
	   )
    )
    (alert (strcat "\n" blk " needs to exist in drawing!"))
  )
  (princ)
)(vl-load-com)

Community

Lisp to insert blocks on Polylines

Lisp to insert blocks on Polylines

Lisp to insert blocks on Polylines