Processing a selection set of LightWeight Polylines to provide midpoints

[KarlG]

I cant seem to pass in any way a selection set for each polyline to place a point at the midpoint of a each polyline?

Its driving me nuts, I have tried modifying the origianal code to select the list and process that way but it still isnt working

 

(defun c:MidPoly ( / ent ename entl en oname param len hLen MidPt OS )
(vl-load-com)
(setq ent (entsel "\nSelect polyline:"))
   (if ent
       (progn
           (setq    ename (car ent)
                   entl (entget ename)
                   en (cdr (assoc 0 entl))
           )
           (if (member en (list "POLYLINE" "LWPOLYLINE"))
               (progn
                   (setq    oname (vlax-ename->vla-object ename)
                           param (vlax-curve-getEndParam oname)
                           len (vlax-curve-getDistAtParam oname param)
                           hLen (* 0.5 len)
                           MidPt (vlax-curve-getPointAtDist oname hLen)
                   )
                   (vlax-release-object oname)
                   (setq OS (getvar "OSMODE"))
                   (setvar "OSMODE" 0)
                   (command "._Point" MidPt)
                   (princ "\nPoint object created at mid-point:")(princ MidPt)
                   (setvar "OSMODE" OS)
               )
               (princ "\nYou must pick a polyline object only.")
               
           )
       )
   )
(prin1)
)
(defun c:test1 ( / e i s x )
   (if (setq s (ssget "_X" (list (cons 8 "MGA55_ROW_Stripping_Depth") (cons 0 "LWPOLYLINE"))))
       (progn
           (setq i (1- (sslength s)))
           (while (<= 0 i)
               (setq e (ssname s i)
                     x (cdr (assoc 0 (entget e)))
                     i (1- i)
               )
               (command "(c:MIDPOLY)" e)
               (print x)
           )
       )
   )
   (princ)
)
(defun c:test2 ( / e i s x )
   (if (setq s (ssget "_X" (list (cons 8 "MGA55_ROW_Stripping_Depth") (cons 0 "LWPOLYLINE"))))
       (progn
           (setq i 0)
           (repeat (sslength s)
               (setq e (ssname s i)
                     x (cdr (assoc 0 (entget e)))
                     i (1+ i)
               )
               (command "(c:MIDPOLY)" e)
               (print x)
           )
       )
   )
   (princ)
)
(defun c:test3 ( / s )
   (if (setq s (ssget "_X" (list (cons 8 "MGA55_ROW_Stripping_Depth") (cons 0 "LWPOLYLINE"))))
       (foreach e (ssnamex s)
           (if (= 'ename (type (cadr e)))
               (command "(c:MIDPOLY)" (cdr (assoc 0 (entget (cadr e)))))
           )
       )
   )
   (princ)
)
(defun c:test4 ( / e s )
   (if (setq s (ssget "_X" (list (cons 8 "MGA55_ROW_Stripping_Depth") (cons 0 "LWPOLYLINE"))))
       (while (setq e (ssname s 0))
           (print (cdr (assoc 0 (entget e))))
           (setq x (cdr (assoc 0 (entget e))))
           (command "(c:MIDPOLY)" e)
           (ssdel e s)
       )
   )
   (princ)
)

I also want to do the same for Lines using this:

 

 

(defun c:MIDLINE ( / ent nPt p2 p1 )
   (if (setq ent (car (entsel "\nSelect line:")))
       (progn
           (setq    p1 (cdr (assoc 10 (entget ent)))
                   p2 (cdr (assoc 11 (entget ent)))
           )
           (setq npt (Line-centroid p1 p2))
           (setq OS (getvar "OSMODE"))
           (setvar "OSMODE" 0)
           (command "._Point" nPt)
           (princ "\nPoint object created at mid-point:")(princ nPt)
           (setvar "OSMODE" OS)
       )
   )
)

(defun Line-centroid (p1 p2)
(mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
)

[hanhphuc]

I cant seem to pass in any way a selection set for each polyline to place a point at the midpoint of a each polyline?

Its driving me nuts, I have tried modifying the origianal code to select the list and process that way but it still isnt working

 

 

hi suggestion defun with argument without prefix c:

(vl-load-com) 
(defun [b][color="blue"]MidPoly[/color][/b] ( [color="red"]ename[/color] /  ename entl en oname param len hLen MidPt OS )

   (if [color="red"]ename[/color]
       (progn
           (setq   
                   entl (entget ename)
                   en (cdr (assoc 0 entl))
           )
...
...
...

 

example:

(defun c:test1 ( / e i s x )
...
...
...
       
[color="green"];;;  (command "(c:MIDPOLY)" e) ; ignore this [/color] 
([color="blue"][b]MidPoly[/b][/color] e)
...
...

 

p/s: vlax-curve- function can be applied for line, polyline, arc, spline etc..

[dlanorh]

See code below for guidance. This is pretty basic but does what you want, but you may need to flesh it out.

 

 

;; This lisp will work with : 
;; Lines 
;; LWPolylines (curved or straight)
;; 3DPolylines (curved or straight)
;; Splines
;;

(vl-load-com)

(defun c:midpts ( / *error* c_doc ms ss l_obj m_dist i_pt 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

 (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"))));<<================================= Disallows objects on locked layers select on screen cossing, window or individually
 
 (vlax-for l_obj (vla-get-activeselectionset c_doc);<<==================================================== Gets selectionset as objects allowing vlax-for to be used to iterate set
   (setq m_dist (/ (vlax-curve-getdistatpoint l_obj (vlax-curve-getendpoint l_obj)) 2);<<================= calculates half the length of the line
         i_pt (vlax-curve-getpointatdist l_obj m_dist);<<================================================= Midpoint 
         n_obj (vla-AddPoint ms (vlax-3D-point i_pt))
   );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)

[marko_ribar]

http://forums.augi.com/showthread.php?171946-Processing-a-selection-set-of-LightWeight-Polylines-to-provide-midpoints&p=#2

[KarlG]

Thanks dlanorh

That code worked the best and also helped me develop further lisp files (being on hiatus from programming in general for 3 years shows)

 

 

Thanks to everyone for the quick response and pointers.

 

 

 

 

See code below for guidance. This is pretty basic but does what you want, but you may need to flesh it out.

 

 

;; This lisp will work with : 
;; Lines 
;; LWPolylines (curved or straight)
;; 3DPolylines (curved or straight)
;; Splines
;;

(vl-load-com)

(defun c:midpts ( / *error* c_doc ms ss l_obj m_dist i_pt 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

 (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"))));<<================================= Disallows objects on locked layers select on screen cossing, window or individually
 
 (vlax-for l_obj (vla-get-activeselectionset c_doc);<<==================================================== Gets selectionset as objects allowing vlax-for to be used to iterate set
   (setq m_dist (/ (vlax-curve-getdistatpoint l_obj (vlax-curve-getendpoint l_obj)) 2);<<================= calculates half the length of the line
         i_pt (vlax-curve-getpointatdist l_obj m_dist);<<================================================= Midpoint 
         n_obj (vla-AddPoint ms (vlax-3D-point i_pt))
   );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)