center of gravity of open polyline

anyone has a lips that can locate center of gravity of lines of an open polyline?

If your pline doesn't have arcs, this should work

(defun c:cgpline (/ dst lst mdp mdx mdy ss x y en pt)
 (if
   (setq ss (ssget ":E:S:L" '((0 . "LWPOLYLINE"))))
    (progn
      (setq lst (mapcar 'cdr
                        (vl-remove-if
                          '(lambda (x) (/= (car x) 10))
                          (setq en (entget (ssname ss 0)))
                        )
                )
            dst (mapcar 'distance lst (cdr lst))
            mdp (mapcar '(lambda (x y)
                           (mapcar '(lambda (a b) (* 0.5 (+ a b))) x y)
                         )
                        lst
                        (cdr lst)
                )
            mdx (mapcar 'car mdp)
            mdy (mapcar 'cadr mdp)
            x   (/ (apply '+ (mapcar '* mdx dst)) (apply '+ dst))
            y   (/ (apply '+ (mapcar '* mdy dst)) (apply '+ dst))
            pt  (trans (list x
                             y
                             (cond ((cdr (assoc 38 en)))
                                   (0.0)
                             )
                       )
                       (trans '(0. 0. 1.) (cdr (assoc 210 en)) 0 T)
                       0
                )
      )
      (entmake (list '(0 . "POINT") (cons 10 pt)))
    )
 )
 (princ)
)

@Stefan . I think your routine not give the correct center point a Polyline .

My version .... with window selection set which means as many as you want with one shut .

(defun c:TesT (/ pl i sn e lst pts n i x y)
 ;;; Tharwat 12. Dec. 2011 ;;
 (if (setq pl (ssget '((0 . "*POLYLINE"))))
   (repeat (setq i (sslength pl))
     (setq sn (ssname pl (setq i (1- i))))
     (setq e (entget sn))
     (setq lst (vl-remove-if-not
                 (function (lambda (x)
                             (if (eq (car x) 10)
                               (setq pts (cons (list (cadr x) (caddr x)) pts))
                             )
                           )
                 )
                 e
               )
     )
     (setq i 0 x 0 y 0 )
     (repeat (setq n (length pts))
       (setq x (+ (car (nth i pts)) x))
       (setq y (+ (cadr (nth i pts)) y))
       (setq i (1+ i))
     )
     (entmake (list '(0 . "POINT") (cons 10 (list (/ x (length pts)) (/ y (length pts))))))
   )
   (princ)
 )
 (princ)
)

The cheat's way:

(defun c:test ( / c o r s ) (vl-load-com)
   (if (setq s (ssget "_+.:E:S:L" '((0 . "*POLYLINE"))))
       (progn
           (setq o (vlax-ename->vla-object (ssname s 0))
                 s (vla-objectidtoobject (vla-get-activedocument (vlax-get-acad-object)) (vla-get-ownerid o))
                 c (vla-get-closed o)
           )
           (vla-put-closed o :vlax-true)
           (setq r (car (vlax-invoke s 'addregion (list o))))
           (vlax-invoke s 'addpoint (trans (vlax-get r 'centroid) 1 0))
           (vla-delete r)
           (vla-put-closed o c)
       )
   )
   (princ)
)

@Tharwat, I don't see the point of:

(setq lst (vl-remove-if-not
           (function (lambda (x)
                       (if (eq (car x) 10)
                         (setq pts (cons (list (cadr x) (caddr x)) pts))
                       )
                     )
           )
           e
         )
)

@Tharwat, I don't see the point of:

 

(setq lst (vl-remove-if-not
           (function (lambda (x)
                       (if (eq (car x) 10)
                         (setq pts (cons (list (cadr x) (caddr x)) pts))
                       )
                     )
           )
           e
         )
)

I am sure that you know each piece of the code , and if you indicate to the two names of variables , actually I just wanted to get the coordinates without the first 10 of each one .

By the way , have you seen this request Here ?

Thanks

I am sure that you know each piece of the code , and if you indicate to the two names of variables , actually I just wanted to get the coordinates without the first 10 of each one .

I was indicating that the use of the vl-remove-if-not function is redundant since you are not using the list returned (variable 'lst').

Consider instead the following:

(foreach pair (entget <entity>)
   (if (= 10 (car pair))
       (setq pts (cons (cdr pair) pts))
   )
)

@Stefan . I think your routine not give the correct center point a Polyline .

I think OP wants the CG of the contour, like a very very thin wire...

anyone has a lips that can locate center of gravity of lines of an open polyline?

I could be wrong, then indeed my point is calculated wrong.

In the link given by Lee, Evgeniy gave three methods for calculating the center of gravity:

1) for an area

2) for an outline

3) for the masses concentrated in nodes

Mine calculates center of gravity as in the second.

On the other hand, I tried your lisp and Lee's ... The results are different ...

Edit: Tharwat, your routine is calculating the media of vertices position, not a gravity center.

I was indicating that the use of the vl-remove-if-not function is redundant since you are not using the list returned (variable 'lst').

 

Consider instead the following:

 

(foreach pair (entget <entity>)
   (if (= 10 (car pair))
       (setq pts (cons (cdr pair) pts))
   )
)

That's right , and besides that we can use mapcar function also for the same situation .

(mapcar
       (function
         (lambda (x)
           (if (eq (car x) 10)
             (setq pts (cons (list (cadr x) (caddr x)) pts))
           )
         )
       )
       e
     )

Thank you

My code above is returning the centroid, Tharwat is just averaging the points which I believe would only work on regular polygons and triangles.

Here is another way to return the centroid for an LWPolyline Polygon:

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] e )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] e ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S"[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]))))
       ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"POINT"[/color]) ([color=BLUE]cons[/color] 10 (LM:PolyCentroid ([color=BLUE]ssname[/color] e 0)))))
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Polygon Centroid  -  Lee Mac[/color]
[color=GREEN];; Returns the centroid of an LWPolyline Polygon[/color]

([color=BLUE]defun[/color] LM:PolyCentroid ( e [color=BLUE]/[/color] l )
   ([color=BLUE]foreach[/color] x ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] e))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x)) ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] x) l)))
   )
   (
       ([color=BLUE]lambda[/color] ( a )
           ([color=BLUE]trans[/color]
               ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color]
                   ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color]
                       ([color=BLUE]cons[/color] '[color=BLUE]+[/color]
                           ([color=BLUE]mapcar[/color]
                               ([color=BLUE]function[/color]
                                   ([color=BLUE]lambda[/color] ( a b )
                                       (
                                           ([color=BLUE]lambda[/color] ( m )
                                               ([color=BLUE]mapcar[/color]
                                                   ([color=BLUE]function[/color]
                                                       ([color=BLUE]lambda[/color] ( c d ) ([color=BLUE]*[/color] ([color=BLUE]+[/color] c d) m))
                                                   )
                                                   a b
                                               )
                                           )
                                           ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]car[/color] a) ([color=BLUE]cadr[/color] b)) ([color=BLUE]*[/color] ([color=BLUE]car[/color] b) ([color=BLUE]cadr[/color] a)))
                                       )
                                   )
                               )
                               l ([color=BLUE]cons[/color] ([color=BLUE]last[/color] l) l)
                           )
                       )
                   )
                   ([color=BLUE]list[/color] a a)
               )
               ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 e)) 0
           )
       )
       ([color=BLUE]*[/color] 3.0
           ([color=BLUE]apply[/color] '[color=BLUE]+[/color]
               ([color=BLUE]mapcar[/color]
                   ([color=BLUE]function[/color]
                       ([color=BLUE]lambda[/color] ( a b )
                           ([color=BLUE]-[/color] ([color=BLUE]*[/color] ([color=BLUE]car[/color] a) ([color=BLUE]cadr[/color] b)) ([color=BLUE]*[/color] ([color=BLUE]car[/color] b) ([color=BLUE]cadr[/color] a)))
                       )
                   )
                   l ([color=BLUE]cons[/color] ([color=BLUE]last[/color] l) l)
               )
           )
       )
   )
)

The above return the same result as my previous code (which uses regions) and the same result as gile's code in the linked thread for LWPolyline Polygons (i.e. non-self-intersecting LWPolylines with straight-segments).