Modify LISP to use LWPOLYLINES

[jtm2020hyo]

I need change this lisp to use LWPOLYLINES instead of ARC/LINES.

this lisp INSert  Aligned BLOCKs in ARCs/LINEs midpoints.

I tried to change :

           t
         )
         (progn (prompt "\n Select lines ...")
                (setq ss (ssget '((0 . "LINE"))))
         )
    )

to :

           t
         )
         (progn (prompt "\n Select lines ...")
                (setq ss (ssget '((0 . "LWPOLYLINE"))))
         )
    )

but it did not work.

Original lisp code :

(defun c:Mins (/ name ss i e p1 p2)
  (if
    (and (or (/= (setq name (getstring t "\n Specify Block name :")) "")
             (/= name nil)
         )
         (if (not (tblsearch "BLOCK" name))
           (progn
             (alert " name of Block is not found !!")
             nil
           )
           t
         )
         (progn (prompt "\n Select lines ...")
                (setq ss (ssget '((0 . "LINE"))))
         )
    )
     (repeat (setq i (sslength ss))
       (setq e (entget (ssname ss (setq i (1- i)))))
       (entmakex
         (list '(0 . "INSERT")
               (cons 10
                     (mapcar (function (lambda (q p) (/ (+ q p) 2.)))
                             (setq p1 (cdr (assoc 10 e)))
                             (setq p2 (cdr (assoc 11 e)))
                     )
               )
               (cons 2 name)
               (cons 50 (angle p1 p2))
               '(41 . 1.0)
               '(42 . 1.0)
               '(43 . 1.0)
         )
       )
     )
     (princ)
  )
  (princ)
)

[dlanorh]

Do you want this to only work with lwpolylines or all types of line entities?
Your change of selection works, but the calculating the mid-point and angle doesn't work and will need changing hence the question

[Kent1Cooper]

---

@jtm2020hyo wrote:

.... INSert  Aligned BLOCKs in ARCs/LINEs midpoints. .... 

---

You can use MarkMidPoints.lsp with its MMP command, available >here<.  It will do it on not just Lines and Arcs and Polylines, but also Splines, Circles, and Ellipses.  And for Polylines, you have the choice of whether to put the marker at the overall  midpoint or at the midpoint of every segment.  You can mark with Blocks as in your routine, or with Points or Lines.

[pbejse]

---

@jtm2020hyo wrote:

I need change this lisp to use LWPOLYLINES instead of ARC/LINES.

---

Not what you ask for but  it accepts ARCS/LINES and LWPOLYLINES

(defun c:Mins (/ _Midof name ss i e  data dxf50)
(defun _Midof (ent / len mid ang)
;;;		pBe May 2018		;;;
  (setq
    len	(vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))
  )
  (setq mid (vlax-curve-getpointatdist ent (* len 0.5)))
  (setq	ang (angle '(0.0 0.0 0.0)
		   (vlax-curve-getfirstderiv
		     ent
		     (vlax-curve-getparamatpoint ent mid)
		   )
	    )
  )
  (list mid ang)
)
  
  (if
    (and (or (/= (setq name (getstring t "\n Specify Block name :")) "")
             (/= name nil)
         )
         (if (not (tblsearch "BLOCK" name))
           (progn
             (alert " name of Block is not found !!")
             nil
           )
           t
         )
         (progn (prompt "\n Select lines ...")
                (setq ss (ssget '((0 . "LWPOLYLINE,LINE,ARC"))))
         )
    )
     (repeat (setq i (sslength ss))
       (setq e (ssname ss (setq i (1- i))))
       (setq data (_Midof e))
       (Setq dxf50 (Cadr data))
       (entmakex
         (list '(0 . "INSERT")
               (cons 10 (Car data))
               (cons 2 name)
		(Cons 50
		      (if (and
			    (> dxf50 (/ pi 2))
			    (<= dxf50 (* pi 1.5))
			  )
			(+ dxf50 pi)
			dxf50
		      )
		)
               '(41 . 1.0)
               '(42 . 1.0)
               '(43 . 1.0)
         )
       )
     )
     (princ)
  )
  (princ)
)

 

HTH

[Anonymous]

 Qustion, is there any way to modify your pld.lisp to add arc's that can follow the contour of a line. I work with cnc's and they are not to keen on loading an excessive amount of lines. If i diet the lines to much with out arc's it will leave hard angles that will have to be hand sanded off. I left examples in the attachment.

[dlanorh]

Not exactly what you asked for. Will handle all lines, polylines, splines and arcs.

(defun c:Mins ( / *error* c_doc ms blk_name ss l_obj m_dist i_pt b_rot n_obj)

	(defun *error* ( msg )
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(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))
        ms (vla-get-modelspace c_doc)
  );end_setq

  (while (not blk_name)
    (setq blk_name (getstring t "\nSpecify Block Name : "))
    (cond ( (not blk_name) 
            (alert "You must specify a Block Name")
          )
          ( (not (tblsearch "BLOCK" blk_name))
            (alert (strcat "Block Name : " blk_name " NOT found in drawing!!"))
            (exit)
          )
    );end_cond
  );end_while
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (prompt "\nSelect Lines, Polylines, Splines, Arcs  : ")
  (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,SPLINE,ARC"))))
  
  (vlax-for l_obj (vla-get-activeselectionset c_doc)
    (setq m_dist (/ (vlax-curve-getdistatpoint l_obj (vlax-curve-getendpoint l_obj)) 2);
          i_pt (vlax-curve-getpointatdist l_obj m_dist) 
          b_rot (angle '(0 0 0) (vlax-curve-getfirstderiv l_obj (vlax-curve-getparamatpoint l_obj i_pt)))
          n_obj (vla-InsertBlock ms (vlax-3d-point i_pt) blk_name 1 1 1 b_rot)
    );end_setq
  );end_vlax-for  
  (setq ss nil)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun
(princ)

[Anonymous]

i attempted to try your new .lsp with no success, i may be using it wrong but i dont know. 

[dlanorh]

Whose new Lisp, there are two, and it seems both are missing

(vl-load-com)  as the first line in the file, and were in reply to the initial question (first post)

[dlanorh]

Above code is incorrect. Correct code should be

(vl-load-com)

(defun c:Mins ( / *error* c_doc ms blk_name ss l_obj m_dist i_pt b_rot n_obj)

	(defun *error* ( msg )
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(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))
        ms (vla-get-modelspace c_doc)
  );end_setq

  (while (not blk_name)
    (setq blk_name (getstring t "\nSpecify Block Name : "))
    (cond ( (not blk_name) 
            (alert "You must specify a Block Name")
          )
          ( (not (tblsearch "BLOCK" blk_name))
            (alert (strcat "Block Name : " blk_name " NOT found in drawing!!"))
            (exit)
          )
    );end_cond
  );end_while
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (prompt "\nSelect Lines, Polylines, Splines, Arcs  : ")
  (setq ss (ssget ":L" '((0 . "LINE,LWPOLYLINE,POLYLINE,SPLINE,ARC"))))
  
  (vlax-for l_obj (vla-get-activeselectionset c_doc)
    (setq m_dist (/ (vlax-curve-getdistatpoint l_obj (vlax-curve-getendpoint l_obj)) 2)
          i_pt (vlax-curve-getpointatdist l_obj m_dist) 
          b_rot (angle '(0 0 0) (vlax-curve-getfirstderiv l_obj (vlax-curve-getparamatpoint l_obj i_pt)))
          n_obj (vla-InsertBlock ms (vlax-3d-point i_pt) blk_name 1 1 1 b_rot)
    );end_setq
  );end_vlax-for  
  (setq ss nil)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun
(princ)

[jtm2020hyo]

impressive lisp. Can be modified to allow select multiple lwpolyline/arc/lines/splines/all-lines-types at same time ?

[jtm2020hyo]

yes to all. I need all lines types and if possible rewrite code. I just need work.

[jtm2020hyo]

lisp work when exploding (explode command) lwpolylines. but I need work with joined (referent to Join command) lwpolyline.

[jtm2020hyo]

this lisp just works for exploded lines types. I need use in multiple lines. 

@dlanorh

[dlanorh]

---

@jtm2020hyowrote:

impressive lisp. Can be modified to allow select multiple lwpolyline/arc/lines/splines/all-lines-types at same time ?

---

My lisp will already work with multiple selections at the same time. See revised code

[dlanorh]

---

@jtm2020hyowrote:

lisp work when exploding (explode command) lwpolylines. but I need work with joined (referent to Join command) lwpolyline.

---

I'm not sure what you mean.

[jtm2020hyo]

 Kent1Cooper Mentor
17 hours ago
  
Re: Modify LISP to use LWPOLYLINES 
@juanj67m wrote:
.... INSert  Aligned BLOCKs in ARCs/LINEs midpoints. .... 

You can use MarkMidPoints.lsp with its MMP command, available >here<.  It will do it on not just Lines and Arcs and Polylines, but also Splines, Circles, and Ellipses.  And for Polylines, you have the choice of whether to put the marker at the overall  midpoint or at the midpoint of every segment.  You can mark with Blocks as in your routine, or with Points or Lines.

 

Kent Cooper, AIA
 

 @Kent1Cooper

this lisp work pretty well but I need use it in multiple *lines

[jtm2020hyo]

I need insert blocks in segment polyline midpoint.

[dlanorh]

---

@jtm2020hyowrote:

I need insert blocks in segment polyline midpoint.

---

(vl-load-com)

(defun rh:sammelung_n (o_lst grouping / tmp n_lst)
	(setq n_lst nil)
	(if (= (rem (length o_lst) grouping) 0)
		(while o_lst
			(while (< (length tmp) grouping)
				(setq tmp (cons (car o_lst) tmp)
							o_lst (cdr o_lst)
				)
			)
			(setq n_lst (cons (reverse tmp) n_lst) 
						tmp nil
			)
		)
		(princ "\nModulus Error : The passed list length is not exactly divisible by the group size!!")
	)
  (reverse n_lst)
)

(defun c:Mins ( / *error* c_doc ms blk_name ss l_obj m_dist i_pt b_rot n_obj)

	(defun *error* ( msg )
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
		(princ)
	);_end_*error*_defun

	(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        ms (vla-get-modelspace c_doc)
  );end_setq

  (while (not blk_name)
    (setq blk_name (getstring t "\nSpecify Block Name : "))
    (cond ( (not blk_name) 
            (alert "You must specify a Block Name")
          )
          ( (not (tblsearch "BLOCK" blk_name))
            (alert (strcat "Block Name : " blk_name " NOT found in drawing!!"))
            (exit)
          )
    );end_cond
  );end_while
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (prompt "\nSelect Lines|Polylines|Splines|Arcs  : ")
  (setq ss (ssget ":L" '((0 . "LWPOLYLINE"))))
  (vlax-for l_obj (vla-get-activeselectionset c_doc)
    (setq p_coords (rh:sammelung_n (vlax-get l_obj 'coordinates) 2)
          start 0
          end 1
          p_len (length p_coords)
    )
    (while (<= end p_len)
      (setq s_dist (distance (nth start p_coords) (nth end p_coords))
            s_ang (angle (nth start p_coords) (nth end p_coords))
            m_pt (polar (nth start p_coords) s_ang (/ s_dist 2))
            n_obj (vla-InsertBlock ms (vlax-3d-point m_pt) blk_name 1 1 1 s_ang)
            start (1+ start)
            end (1+ end)
      )
    )  
  );end_vlax-for  
  (setq ss nil)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun
(princ)

This should work for straight LWPolylines ONLY.  It will not work on LWPolylines on locked layers and you should be able to select multiple lines.

[dlanorh]

---

@jtm2020hyowrote:

I need insert blocks in segment polyline midpoint.

---

OK. The lisp below will work for Lines, all Polylines (straight and curved), Splines and Arcs. It allows multiple lines to be selected and will process all selected lines. At present it will not selected any entity on a locked layer. If you want that changing let me know.

Lines, Arcs and Splines work as before, one block mid point of line.

Straight Polylines (LW £D) block mid point of each segment.

Curved polylines.

There is a problem here. Due to the nature of Spline fits you end up with a lot of extra segments. The lisp will put a block on the mid point of every segment.

Fitted Curves have double the number of segments to its straight counterpart. Again a block is inserted at the mid point of each segment.

It is possible to reduce the number of inserted blocks for curved polylines by half. If you want me to do this let me know.

Finally do you want the blocks inserted onto the same layer as the line|polyline|spline|arc?

(vl-load-com)

(defun c:Mins ( / *error* c_doc ms blk_name ss l_obj m_dist m_pt s_ang n_obj params param)

	(defun *error* ( msg )
	  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	  (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
	  (princ)
	);_end_*error*_defun

	(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
              ms (vla-get-modelspace c_doc)
        );end_setq

  (while (not blk_name)
    (setq blk_name (getstring t "\nSpecify Block Name : "))
    (cond ( (not blk_name) 
            (alert "You must specify a Block Name")
          )
          ( (not (tblsearch "BLOCK" blk_name))
            (alert (strcat "Block Name : " blk_name " NOT found in drawing!!"))
            (exit)
          )
    );end_cond
  );end_while
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (prompt "\nSelect Lines|Polylines|Splines|Arcs  : ")
  (setq ss (ssget ":L" '((0 . "LINE,LWPOLYLINE,POLYLINE,SPLINE,ARC"))))
  (vlax-for l_obj (vla-get-activeselectionset c_doc)
    (cond ( (wcmatch (vla-get-objectname l_obj) "*Polyline");was 2DPolyline
            (setq params (vlax-curve-getparamatpoint l_obj (vlax-curve-getendpoint l_obj))
                  param 0.5
            );end_setq
            (while (< param params)
              (setq m_pt (vlax-curve-getpointatparam l_obj param)
                    s_ang (angle '(0 0 0) (vlax-curve-getfirstderiv l_obj (vlax-curve-getparamatpoint l_obj m_pt)))
                    n_obj (vla-InsertBlock ms (vlax-3d-point m_pt) blk_name 1 1 1 s_ang)
                    param (1+ param)
              );end_setq
            );end_while
          );end_sub_cond
          (t
            (setq m_dist (/ (vlax-curve-getdistatpoint l_obj (vlax-curve-getendpoint l_obj)) 2);
                  m_pt (vlax-curve-getpointatdist l_obj m_dist) 
                  s_ang (angle '(0 0 0) (vlax-curve-getfirstderiv l_obj (vlax-curve-getparamatpoint l_obj m_pt)))
                  n_obj (vla-InsertBlock ms (vlax-3d-point m_pt) blk_name 1 1 1 s_ang)
            );end_setq
          );end_sub_cond
    );end_cond      
  );end_vlax-for  
  (setq ss nil)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun
(princ)

[Kent1Cooper · Accepted solution]

---

@jtm2020hyo wrote:

 @Kent1Cooper

this lisp work pretty well but I need use it in multiple *lines

---

Here's an updated version that allows multiple object selection.  [Lightly tested]