topic Re: Lisp to insert blocks on Polylines in Visual LISP, AutoLISP and General Customization Forum

Lisp to insert blocks on Polylines

Anonymous — Wed, 04 Sep 2019 14:11:37 GMT

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

Re: Lisp to insert blocks on Polylines

dlanorh — Wed, 04 Sep 2019 14:40:30 GMT

@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)?

Re: Lisp to insert blocks on Polylines

CodeDing — Wed, 04 Sep 2019 14:43:15 GMT

@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

Re: Lisp to insert blocks on Polylines

Anonymous — Thu, 05 Sep 2019 05:17:11 GMT

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

Re: Lisp to insert blocks on Polylines

Kent1Cooper — Thu, 05 Sep 2019 10:27:39 GMT

@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)))

)

Re: Lisp to insert blocks on Polylines

Kent1Cooper — Thu, 05 Sep 2019 11:31:34 GMT

@Kent1Cooper wrote:
Try replacing this:

....

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

(vl-load-com)

Re: Lisp to insert blocks on Polylines

dlanorh — Thu, 05 Sep 2019 11:33:58 GMT

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)

Re: Lisp to insert blocks on Polylines

Kent1Cooper — Thu, 05 Sep 2019 13:30:31 GMT

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
....

Re: Lisp to insert blocks on Polylines

dlanorh — Thu, 05 Sep 2019 13:57:29 GMT

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.

Re: Lisp to insert blocks on Polylines

ronjonp — Thu, 05 Sep 2019 16:52:42 GMT

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)

Re: Lisp to insert blocks on Polylines

Anonymous — Sun, 08 Sep 2019 09:40:36 GMT

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

Thanks again.

Regards

Jaleel

Re: Lisp to insert blocks on Polylines

Anonymous — Tue, 03 Mar 2020 05:50:12 GMT

@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

Re: Lisp to insert blocks on Polylines

dlanorh — Tue, 03 Mar 2020 10:23:17 GMT

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.

Re: Lisp to insert blocks on Polylines

Kent1Cooper — Tue, 03 Mar 2020 13:14:07 GMT

@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.

Re: Lisp to insert blocks on Polylines

Anonymous — Wed, 04 Mar 2020 09:08:59 GMT

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

thanks

Re: Lisp to insert blocks on Polylines

ronjonp — Wed, 04 Mar 2020 15:16:39 GMT

@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)