Author Topic: Lwpolyline centroid  (Read 3925 times)

0 Members and 1 Guest are viewing this topic.

gile

  • Water Moccasin
  • Posts: 1740
  • Marseille, France
Lwpolyline centroid
« on: September 15, 2007, 06:22:50 am »
Hi,

Determine a lwpolyline centroid is a frequently asked question.
Doing this, I used to create a region from the pline, get the region centroid and delete the region (using vlisp).
It's not very clean, but it works (provided that the region is on XY plane of current UCS).

Code: [Select]
(defun vl-pline-centroid (pl / AcDoc Space obj reg cen)
(vl-load-com)
(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
)
(or (= (type pl) 'VLA-OBJECT)
(setq obj (vlax-ename->vla-object pl))
)
(setq reg (vlax-invoke Space 'addRegion (list obj))
cen (vlax-get (car reg) 'Centroid)
)
(vla-delete (car reg))
(trans cen 1 (vlax-get obj 'Normal))
)


Recently, a guy working on an acad clone (not supporting vlisp) made me discover a routine from Reini Urban's Std Lib : GEOM-CENTROID2D
This routine works fine with plines which don't have arcs, so I tried to modify/complete it to be use with polyarcs too and to work whatever the pline OCS and elevation and whatever the current UCS.

PS : Obviously, this method seems to run more than 3 time faster than the vlisp/region one. Perhaps due to the modeler needed to create the region.

Code: [Select]
;; ALGEB-AREA
;; Returns tha algebraic area of the triangle defined by 3  2d points
;; the area is negative if points are clockwise

(defun algeb-area (p1 p2 p3)
  (/ (- (* (- (car p2) (car p1))
   (- (cadr p3) (cadr p1))
)
(* (- (car p3) (car p1))
   (- (cadr p2) (cadr p1))
)
     )
     2.0
  )
)

;; TRIANGLE-CENTROID
;; Returns the centroid of a triangle defined by 3 points

(defun triangle-centroid (p1 p2 p3)
  (mapcar '(lambda (x1 x2 x3)
     (/ (+ x1 x2 x3) 3.0)
   )
  p1
  p2
  p3
  )
)

;; POLYARC-CENTROID
;; Returns a list which first item is the centroid of a 'polyarc'
;; and the second its algeraic area
;;
;; Arguments
;; bu : polyarc bulge
;; p1 : start point
;; p2 : end point

(defun polyarc-centroid (bu p1 p2 / ang rad cen area dist cg)
  (setq ang  (* 2 (atan bu))
rad  (/ (distance p1 p2)
(* 2 (sin ang))
     )
cen  (polar p1
    (+ (angle p1 p2) (- (/ pi 2) ang))
    rad
     )
area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
dist (/ (expt (distance p1 p2) 3) (* 12 area))
cg   (polar cen
    (- (angle p1 p2) (/ pi 2))
    dist
     )
  )
  (list cg area)
)

;; PLINE-CENTROID
;; Returns the WCS coordinates of a lwpolyline centroid
;;
;; Argument
;; pl : the lwpolyline ename

(defun pline-centroid (pl / elst lst tot cen p0 area cen)
  (setq elst (entget pl))
  (while (setq elst (member (assoc 10 elst) elst))
    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
  elst (cdr elst)
    )
  )
  (setq lst (reverse lst)
tot 0.0
cen '(0.0 0.0)
p0  (caar lst)
  )
  (if (/= 0 (cdar lst))
    (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst))
  cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c))
  tot (cadr p-c)
    )
  )
  (setq lst (cdr lst))
  (if (equal (car (last lst)) p0 1e-9)
    (setq lst (reverse (cdr (reverse lst))))
  )
  (while (cadr lst)
    (setq area (algeb-area p0 (caar lst) (caadr lst))
  cen  (mapcar '(lambda (x1 x2) (+ x1 (* x2 area)))
       cen
       (triangle-centroid p0 (caar lst) (caadr lst))
       )
  tot  (+ area tot)
    )
    (if (/= 0 (cdar lst))
      (setq p-c (polyarc-centroid (cdar lst) (caar lst) (caadr lst))
    cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
cen
(car p-c)
)
    tot (+ tot (cadr p-c))
      )
    )
    (setq lst (cdr lst))
  )
  (if (/= 0 (cdar lst))
    (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0)
  cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c))))
      cen
      (car p-c)
      )
  tot (+ tot (cadr p-c))
    )
  )
  (trans (list (/ (car cen) tot)
       (/ (cadr cen) tot)
       (cdr (assoc 38 (entget pl)))
)
pl
0
  )
)

To test the routine :

Code: [Select]
;; PT-CEN
;; Creates a point on the selected pline centroid

(defun c:pt-cen (/ ent elst elv)
  (and
    (setq ent (car (entsel)))
    (setq elst (entget ent))
    (setq elv (cdr (assoc 38 elst)))
    (= "LWPOLYLINE" (cdr (assoc 0 elst)))
    (entmake
      (list '(0 . "POINT") (cons 10 (pline-centroid ent)))
    )
  )
  (princ)
)
« Last Edit: September 15, 2007, 06:26:33 am by gile »
Speaking English as a French Frog

ElpanovEvgeniy

  • Swamp Rat
  • Posts: 1471
  • Moscow (Russia)
Re: Lwpolyline centroid
« Reply #1 on: September 16, 2007, 01:56:36 am »
Greetings gile!  :-)
Very good and necessary work.
Thanks for share...

PS. On Monday, I shall understand with the program - I liked its some parts...
« Last Edit: September 16, 2007, 01:59:01 am by ElpanovEvgeniy »
My argument has always been that we need to learn how to ask questions as much as we need to learn to solve problems. /Kerry Brown/

gile

  • Water Moccasin
  • Posts: 1740
  • Marseille, France
Re: Lwpolyline centroid
« Reply #2 on: September 16, 2007, 05:00:24 am »
Thanks Evgeniy,
 Some more explainations :
The algorythm (from Joseph O'Rourke ?) to get a polygon centroid is discribed here
The very simple formula (given to me by lili2006@CADxp) to get the distance of an arc centroid from the arc center is :
C^3 / 12 S (where C is the chord and S the arc area)
The arc area (delimited by arc and chord) is
S = R (a - sin a) / 2 (where R is the radius and a the angle arc, a is calculated from the bulge so that if the area is signed as the bulge)
Speaking English as a French Frog

therock003

  • Newt
  • Posts: 111
Re: Lwpolyline centroid
« Reply #3 on: May 26, 2009, 04:22:46 am »
hi guys, i'm interested in this matter. How do i run these routines in order to locate the centroid of closed polylines?

gile

  • Water Moccasin
  • Posts: 1740
  • Marseille, France
Re: Lwpolyline centroid
« Reply #4 on: May 27, 2009, 01:25:50 pm »
Hi,

You can load all the routines in the second code window of the first message (ALGEB-AREA, TRIANGLE-CENTROID, POLYARC-CENTROID, and PLINE-CENTROID).

The pline-centroid returns polyline centroid WCS coordinates (whatever its construction plane).
The polyline ename is the requested argument, so you can use it like this (none error trapping neither control on entity type) :
Code: [Select]
(pline-centroid (car (entsel)))
Or use the PT-CEN command which create a point on the selected pline centroid :

Code: [Select]
;; PT-CEN
;; Creates a point on the selected pline centroid

(defun c:pt-cen (/ ent)
  (if
    (and
      (setq ent (car (entsel)))
      (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
    )
     (entmake
       (list '(0 . "POINT") (cons 10 (pline-centroid ent)))
     )
     (princ "\nNone polyline selected.")
  )
  (princ)
)
Speaking English as a French Frog

VovKa

  • Swamp Rat
  • Posts: 546
Re: Lwpolyline centroid
« Reply #5 on: May 29, 2009, 09:46:01 am »
this one is for happy Autodesk Map users :)
Code: [Select]
(ade_expreval (car (entsel)) ".CENTER" "POINT")

ElpanovEvgeniy

  • Swamp Rat
  • Posts: 1471
  • Moscow (Russia)
Re: Lwpolyline centroid
« Reply #6 on: June 08, 2009, 06:04:00 am »
Finding of the center of weight of a solid detail (lwpolyline, arc).
Finding of the center of weight of a frame detail (lwpolyline, arc).
En
Rus
My argument has always been that we need to learn how to ask questions as much as we need to learn to solve problems. /Kerry Brown/

ElpanovEvgeniy

  • Swamp Rat
  • Posts: 1471
  • Moscow (Russia)
Re: Lwpolyline centroid
« Reply #7 on: June 08, 2009, 11:25:15 am »
Centroid (the center of weights) region, inside of a polyline, having arc segments
Code: [Select]
(defun eea-centroid-solid-lw (pl bl / A1)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) region, inside of a polyline, having arc segments

pl - list point
bl - list bulge

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
      bl nil
) ;_  setq
(foreach a (reverse (entget e))
 (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
       ((= (car a) 42) (setq bl (cons (cdr a) bl)))
 ) ;_  cond
) ;_  foreach

(eea-centroid-solid-lw pl bl)
*****************************************************************************************

(defun c:test (/ e bl pl)
 (setq e (car (entsel "\n Select LWPOLYLINE ")))
 (foreach a (reverse (entget e))
  (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
        ((= (car a) 42) (setq bl (cons (cdr a) bl)))
  ) ;_  cond
 ) ;_  foreach
 (entmakex (list '(0 . "point")
                 '(62 . 1)
                 (cons 10 (eea-centroid-solid-lw pl bl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq a1 0)
 (mapcar
  (function /)
  (apply
   (function mapcar)
   (cons
    (function +)
    (mapcar
     (function
      (lambda (p1 p2 b / A BB C I S)
       (setq i  (/ (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1))) 2)
             a1 (+ i a1)
             i  (/ i 3)
       ) ;_  setq
       (if (zerop b)
        (mapcar (function (lambda (a b) (* (+ a b) i))) p1 p2)
        (progn
         (setq c  (distance p1 p2)
               bb (* b b)
               a  (/ (* c c (- (* (atan b) (1+ bb) (1+ bb)) (* b (- 1 bb)))) (* 8 bb))
               a1 (+ a a1)
               s  (/ (- (* b c c) (* 3 a (- 1 bb))) (* 12 a b))
         ) ;_  setq
         (mapcar (function (lambda (a b c d) (+ (* (+ a b) i) (* d (+ (/ (+ a b) 2) c)))))
                 p1
                 p2
                 (list (* (- (cadr p2) (cadr p1)) s) (* (- (car p2) (car p1)) -1 s))
                 (list a a)
         ) ;_  mapcar
        ) ;_  progn
       ) ;_  if
      ) ;_  lambda
     ) ;_  function
     (cons (last pl) pl)
     pl
     (cons (last bl) bl)
    ) ;_  mapcar
   ) ;_  cons
  ) ;_  apply
  (list a1 a1)
 ) ;_  mapcar
) ;_  defun

The center of the weight located along a contour of a lwpolyline, having arc segments.
Code: [Select]
(defun eea-centroid-curve-lw (pl bl / L)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

The center of the weight located along a contour of a lwpolyline, having arc segments.
As an example, the center of weight of a wire detail

!!! For the closed polylines to add the description of a closing segment.

pl - list point
bl - list bulge

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
      bl nil
) ;_  setq
(foreach a (reverse (entget e))
 (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
       ((= (car a) 42) (setq bl (cons (cdr a) bl)))
 ) ;_  cond
) ;_  foreach

(eea-centroid-curve-lw pl bl)
*****************************************************************************************

(defun c:test (/ e bl pl)
 (setq e (car (entsel)))
 (foreach a (reverse (entget e))
  (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
        ((= (car a) 42) (setq bl (cons (cdr a) bl)))
  ) ;_  cond
 ) ;_  foreach
 (if (= (cdr (assoc 70 (entget e))) 1)
  (setq pl (reverse (cons (car pl) (reverse pl))))
 ) ;_  if
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-curve-lw pl bl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l 0)
 (mapcar
  (Function /)
  (apply
   (function mapcar)
   (cons
    (function +)
    (mapcar
     (function
      (lambda (p1 p2 b / BB C D S)
       (if (zerop b)
        (progn (setq d (distance p1 p2)
                     l (+ d l)
               ) ;_  setq
               (mapcar (function (lambda (a b c) (* (/ (+ a b) 2) c))) p1 p2 (list d d))
        ) ;_  progn
        (progn (setq c  (distance p1 p2)
                     bb (* b b)
                     d  (/ (* c (atan b) (1+ bb)) b)
                     l  (+ d l)
                     s  (- (/ 1 (* 4 (atan b))) (/ (- 1 bb) (* 4 b)))
               ) ;_  setq
               (mapcar (function (lambda (a b c) (* d (+ (/ (+ a b) 2) c))))
                       p1
                       p2
                       (list (* s (- (cadr p2) (cadr p1))) (* s (- (car p1) (car p2))))
               ) ;_  mapcar
        ) ;_  progn
       ) ;_  if
      ) ;_  lambda
     ) ;_  function
     pl
     (cdr pl)
     bl
    ) ;_  mapcar
   ) ;_  cons
  ) ;_  apply
  (list l l)
 ) ;_  mapcar
) ;_  defun

Average point - the center of the weight located in tops of a polyline by equal parts
Code: [Select]
(defun eea-centroid-point-lw (pl)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Average point - the center of the weight located in tops of a polyline by equal parts

pl - list point

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach

(eea-centroid-point-lw pl)
*****************************************************************************************

(defun c:test (/ e bl pl)
 (setq e (car (entsel "\n Select LWPOLYLINE ")))
 (foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach
 (if (= (cdr (assoc 70 (entget e))) 1)
  (setq pl (reverse (cons (car pl) (reverse pl))))
 ) ;_  if
 (entmakex (list '(0 . "point")
                 '(62 . 3)
                 (cons 10 (eea-centroid-point-lw pl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l (length pl))
 (mapcar (function /) (apply (function mapcar) (cons (function +) pl)) (list l l))
) ;_  defun

Centroid (the center of weights) region, inside of a polyline.
Code: [Select]
(defun eea-centroid-solid-pl (pl)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) region, inside of a polyline.

pl - list point

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
 (if (= (car a) 10)
  (setq pl (cons (cdr a) pl))
 ) ;_  if
) ;_  foreach

(eea-centroid-solid-pl pl)
*****************************************************************************************

(defun c:test (/ e bl pl)
 (setq e (car (entsel "\n Select LWPOLYLINE ")))
 (foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach
 (entmakex (list '(0 . "point")
                 '(62 . 1)
                 (cons 10 (eea-centroid-solid-pl pl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l 0)
 (mapcar
  (function /)
  (apply (function mapcar)
         (cons (function +)
               (mapcar (function (lambda (p1 p2 / BL I PL)
                                  (setq i (/ (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1))) 2)
                                        l (+ i l)
                                        i (/ i 3)
                                  ) ;_  setq
                                  (mapcar (function (lambda (a b) (* (+ a b) i))) p1 p2)
                                 ) ;_  lambda
                       ) ;_  function
                       (cons (last pl) pl)
                       pl
               ) ;_  mapcar
         ) ;_  cons
  ) ;_  apply
  (list l l)
 ) ;_  mapcar
) ;_  defun

The center of the weight located along a contour of a lwpolyline.
 Without arc segments.
Code: [Select]
(defun eea-centroid-curve-pl (pl / L)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

The center of the weight located along a contour of a lwpolyline.
 Without arc segments.
As an example, the center of weight of a wire detail

!!! For the closed polylines to add the description of a closing segment.

pl - list point

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
 (if (= (car a) 10)
  (setq pl (cons (cdr a) pl))
 ) ;_  if
) ;_  foreach

(eea-centroid-curve-pl pl)
*****************************************************************************************

(defun c:test (/ e bl pl)
 (setq e (car (entsel)))
 (foreach a (reverse (entget e))
  (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
        ((= (car a) 42) (setq bl (cons (cdr a) bl)))
  ) ;_  cond
 ) ;_  foreach
 (if (= (cdr (assoc 70 (entget e))) 1)
  (setq pl (reverse (cons (car pl) (reverse pl))))
 ) ;_  if
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-curve-pl pl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l 0)
 (mapcar
  (Function /)
  (apply
   (function mapcar)
   (cons
    (function +)
    (mapcar
     (function (lambda (p1 p2 / D)
                (setq d (distance p1 p2)
                      l (+ d l)
                ) ;_  setq
                (mapcar (function (lambda (a b c) (* (/ (+ a b) 2) c))) p1 p2 (list d d))
               ) ;_  lambda
     ) ;_  function
     pl
     (cdr pl)
    ) ;_  mapcar
   ) ;_  cons
  ) ;_  apply
  (list l l)
 ) ;_  mapcar
) ;_  defun

The center of weight, average point, crossing of medians of a triangle
Code: [Select]
(defun eea-centroid-triangle (p1 p2 p3)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

The center of weight, average point, crossing of medians of a triangle

p1 p2 p3 - points triangle

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
 (if (= (car a) 10)
  (setq pl (cons (cdr a) pl))
 ) ;_  if
) ;_  foreach

(eea-centroid-triangle (car pl)(cadr pl)(caddr pl))
*****************************************************************************************

(defun c:test (/ e pl)
 (setq e  (car (entsel "\n Select LWPOLYLINE "))
       pl nil
 ) ;_  setq
 (foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-triangle (car pl) (cadr pl) (caddr pl)))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (mapcar (function (lambda (a b c) (/ (+ a b c) 3))) p1 p2 p3)
) ;_  defun

Centroid (the center of weights) areas, inside of an arc segment of a polyline.
Code: [Select]
(defun eea-centroid-solid-arc (p1 p2 b / BB C)
                              ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) areas, inside of an arc segment of a polyline.

p1 - start segment point
p2 - end segment point
b  - bulge is the tangent of 1/4 of the included angle for the arc segment

Date of creation   2000 - 2008 years.
*****************************************************************************************

(setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
      b  (cdr
          (nth
           (fix
            (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
           ) ;_  fix
           (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
          ) ;_  nth
         ) ;_  cdr
      d  (fix
          (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
         ) ;_  fix
      p1 (vlax-curve-getPointAtParam (car e) d)
      p2 (vlax-curve-getPointAtParam (car e) (1+ d))
) ;_  setq

(eea-centroid-solid-arc p1 p2 b)
*****************************************************************************************

(defun c:test (/ e bl pl)
 (setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
       b  (cdr
           (nth (fix (vlax-curve-getParamAtPoint (car e)
                                                 (vlax-curve-getClosestPointTo (car e) (cadr e))
                     ) ;_  vlax-curve-getParamAtPoint
                ) ;_  fix
                (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
           ) ;_  nth
          ) ;_  cdr
       d  (fix
           (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
          ) ;_  fix
       p1 (vlax-curve-getPointAtParam (car e) d)
       p2 (vlax-curve-getPointAtParam (car e) (1+ d))
 ) ;_  setq
 (entmakex (list '(0 . "point")
                 '(62 . 1)
                 (cons 10 (eea-centroid-solid-arc p1 p2 b))
                 (assoc 210 (entget (car e)))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun
*****************************************************************************************

|;
 (setq bb (* b b)
       с  (distance p1 p2)
       s  (+ (/ (1- bb) (* 4 b))
             (/ (* 2 bb) (* 3 (+ (* (1+ bb) (1+ bb) (atan b)) (* -1 b (1+ bb)) (* 2 b bb))))
          ) ;_  *
 ) ;_  setq
 (mapcar (function (lambda (a b c) (+ (/ (+ a b) 2) c)))
         p1
         p2
         (list (* (- (cadr p2) (cadr p1)) s) (* (- (car p1) (car p2)) s))
 ) ;_  mapcar
) ;_  defun

Centroid (the center of weights) areas, located along a contour of a segment of a polyline.
Code: [Select]
(defun eea-centroid-curved-arc (p1 p2 b / S)
 ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) areas, located along a contour of a segment of a polyline.
As an example, the center of weight of a wire detail

p1 - start segment point
p2 - end segment point
b  - bulge is the tangent of 1/4 of the included angle for the arc segment

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************

(setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
      b  (cdr
          (nth
           (fix
            (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
           ) ;_  fix
           (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
          ) ;_  nth
         ) ;_  cdr
      d  (fix
          (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
         ) ;_  fix
      p1 (vlax-curve-getPointAtParam (car e) d)
      p2 (vlax-curve-getPointAtParam (car e) (1+ d))
) ;_  setq

   
(eea-centroid-curved-arc p1 p2 b)

*****************************************************************************************

(defun c:test (/ e bl pl)
 (setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
       b  (cdr
           (nth (fix (vlax-curve-getParamAtPoint (car e)
                                                 (vlax-curve-getClosestPointTo (car e) (cadr e))
                     ) ;_  vlax-curve-getParamAtPoint
                ) ;_  fix
                (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
           ) ;_  nth
          ) ;_  cdr
       d  (fix
           (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
          ) ;_  fix
       p1 (vlax-curve-getPointAtParam (car e) d)
       p2 (vlax-curve-getPointAtParam (car e) (1+ d))
 ) ;_  setq
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-curved-arc p1 p2 b))
                 (assoc 210 (entget (car e)))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq s (- (/ 1 (* 4 (atan b))) (/ (- 1 (* b b)) (* 4 b))))
 (mapcar (function (lambda (a b c) (+ (/ (+ a b) 2) c)))
         p1
         p2
         (list (* (- (cadr p2) (cadr p1)) s) (* (- (car p1) (car p2)) s))
 ) ;_  mapcar
) ;_  defun
My argument has always been that we need to learn how to ask questions as much as we need to learn to solve problems. /Kerry Brown/

gile

  • Water Moccasin
  • Posts: 1740
  • Marseille, France
Re: Lwpolyline centroid
« Reply #8 on: June 08, 2009, 01:09:44 pm »
Hi,

I tried the "test" command in "eea-centroid-curve-lw" comments, it doesn't returns the same point as "pt-cen".

EDIT both "eea-centroid-solid-lw" and "eea-centroid-curve-lw" returns the same result
« Last Edit: June 08, 2009, 01:18:55 pm by gile »
Speaking English as a French Frog

ElpanovEvgeniy

  • Swamp Rat
  • Posts: 1471
  • Moscow (Russia)
Re: Lwpolyline centroid
« Reply #9 on: June 10, 2009, 03:10:53 am »
Hi,

I tried the "test" command in "eea-centroid-curve-lw" comments, it doesn't returns the same point as "pt-cen".

EDIT both "eea-centroid-solid-lw" and "eea-centroid-curve-lw" returns the same result

The small explanatory to programs.
Hatch designates weight.
My argument has always been that we need to learn how to ask questions as much as we need to learn to solve problems. /Kerry Brown/

ElpanovEvgeniy

  • Swamp Rat
  • Posts: 1471
  • Moscow (Russia)
Re: Lwpolyline centroid
« Reply #10 on: June 10, 2009, 04:27:31 am »
I have replaced the identical name of programs c:test on various c:e1 - c:e8.
I hope, now will be less mistakes.

Centroid (the center of weights) region, inside of a polyline, having arc segments
Code: [Select]
(defun eea-centroid-solid-lw (pl bl / A1)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) region, inside of a polyline, having arc segments

pl - list point
bl - list bulge

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
      bl nil
) ;_  setq
(foreach a (reverse (entget e))
 (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
       ((= (car a) 42) (setq bl (cons (cdr a) bl)))
 ) ;_  cond
) ;_  foreach

(eea-centroid-solid-lw pl bl)
*****************************************************************************************

(defun c:c1 (/ e bl pl)
 (setq e (car (entsel "\n Select LWPOLYLINE ")))
 (foreach a (reverse (entget e))
  (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
        ((= (car a) 42) (setq bl (cons (cdr a) bl)))
  ) ;_  cond
 ) ;_  foreach
 (entmakex (list '(0 . "point")
                 '(62 . 1)
                 (cons 10 (eea-centroid-solid-lw pl bl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq a1 0)
 (mapcar
  (function /)
  (apply
   (function mapcar)
   (cons
    (function +)
    (mapcar
     (function
      (lambda (p1 p2 b / A BB C I S)
       (setq i  (/ (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1))) 2)
             a1 (+ i a1)
             i  (/ i 3)
       ) ;_  setq
       (if (zerop b)
        (mapcar (function (lambda (a b) (* (+ a b) i))) p1 p2)
        (progn
         (setq c  (distance p1 p2)
               bb (* b b)
               a  (/ (* c c (- (* (atan b) (1+ bb) (1+ bb)) (* b (- 1 bb)))) (* 8 bb))
               a1 (+ a a1)
               s  (/ (- (* b c c) (* 3 a (- 1 bb))) (* 12 a b))
         ) ;_  setq
         (mapcar (function (lambda (a b c d) (+ (* (+ a b) i) (* d (+ (/ (+ a b) 2) c)))))
                 p1
                 p2
                 (list (* (- (cadr p2) (cadr p1)) s) (* (- (car p2) (car p1)) -1 s))
                 (list a a)
         ) ;_  mapcar
        ) ;_  progn
       ) ;_  if
      ) ;_  lambda
     ) ;_  function
     (cons (last pl) pl)
     pl
     (cons (last bl) bl)
    ) ;_  mapcar
   ) ;_  cons
  ) ;_  apply
  (list a1 a1)
 ) ;_  mapcar
) ;_  defun

The center of the weight located along a contour of a lwpolyline, having arc segments.
Code: [Select]
(defun eea-centroid-curve-lw (pl bl / L)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

The center of the weight located along a contour of a lwpolyline, having arc segments.
As an example, the center of weight of a wire detail

!!! For the closed polylines to add the description of a closing segment.

pl - list point
bl - list bulge

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
      bl nil
) ;_  setq
(foreach a (reverse (entget e))
 (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
       ((= (car a) 42) (setq bl (cons (cdr a) bl)))
 ) ;_  cond
) ;_  foreach

(eea-centroid-curve-lw pl bl)
*****************************************************************************************

(defun c:c2 (/ e bl pl)
 (setq e (car (entsel)))
 (foreach a (reverse (entget e))
  (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
        ((= (car a) 42) (setq bl (cons (cdr a) bl)))
  ) ;_  cond
 ) ;_  foreach
 (if (= (cdr (assoc 70 (entget e))) 1)
  (setq pl (reverse (cons (car pl) (reverse pl))))
 ) ;_  if
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-curve-lw pl bl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l 0)
 (mapcar
  (Function /)
  (apply
   (function mapcar)
   (cons
    (function +)
    (mapcar
     (function
      (lambda (p1 p2 b / BB C D S)
       (if (zerop b)
        (progn (setq d (distance p1 p2)
                     l (+ d l)
               ) ;_  setq
               (mapcar (function (lambda (a b c) (* (/ (+ a b) 2) c))) p1 p2 (list d d))
        ) ;_  progn
        (progn (setq c  (distance p1 p2)
                     bb (* b b)
                     d  (/ (* c (atan b) (1+ bb)) b)
                     l  (+ d l)
                     s  (- (/ 1 (* 4 (atan b))) (/ (- 1 bb) (* 4 b)))
               ) ;_  setq
               (mapcar (function (lambda (a b c) (* d (+ (/ (+ a b) 2) c))))
                       p1
                       p2
                       (list (* s (- (cadr p2) (cadr p1))) (* s (- (car p1) (car p2))))
               ) ;_  mapcar
        ) ;_  progn
       ) ;_  if
      ) ;_  lambda
     ) ;_  function
     pl
     (cdr pl)
     bl
    ) ;_  mapcar
   ) ;_  cons
  ) ;_  apply
  (list l l)
 ) ;_  mapcar
) ;_  defun

Average point - the center of the weight located in tops of a polyline by equal parts
Code: [Select]
(defun eea-centroid-point-lw (pl)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Average point - the center of the weight located in tops of a polyline by equal parts

pl - list point

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach

(eea-centroid-point-lw pl)
*****************************************************************************************

(defun c:c3 (/ e bl pl)
 (setq e (car (entsel "\n Select LWPOLYLINE ")))
 (foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach
 (if (= (cdr (assoc 70 (entget e))) 1)
  (setq pl (reverse (cons (car pl) (reverse pl))))
 ) ;_  if
 (entmakex (list '(0 . "point")
                 '(62 . 3)
                 (cons 10 (eea-centroid-point-lw pl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l (length pl))
 (mapcar (function /) (apply (function mapcar) (cons (function +) pl)) (list l l))
) ;_  defun

Centroid (the center of weights) region, inside of a polyline.
Code: [Select]
(defun eea-centroid-solid-pl (pl)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) region, inside of a polyline.

pl - list point

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
 (if (= (car a) 10)
  (setq pl (cons (cdr a) pl))
 ) ;_  if
) ;_  foreach

(eea-centroid-solid-pl pl)
*****************************************************************************************

(defun c:c4 (/ e bl pl)
 (setq e (car (entsel "\n Select LWPOLYLINE ")))
 (foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach
 (entmakex (list '(0 . "point")
                 '(62 . 1)
                 (cons 10 (eea-centroid-solid-pl pl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l 0)
 (mapcar
  (function /)
  (apply (function mapcar)
         (cons (function +)
               (mapcar (function (lambda (p1 p2 / BL I PL)
                                  (setq i (/ (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1))) 2)
                                        l (+ i l)
                                        i (/ i 3)
                                  ) ;_  setq
                                  (mapcar (function (lambda (a b) (* (+ a b) i))) p1 p2)
                                 ) ;_  lambda
                       ) ;_  function
                       (cons (last pl) pl)
                       pl
               ) ;_  mapcar
         ) ;_  cons
  ) ;_  apply
  (list l l)
 ) ;_  mapcar
) ;_  defun

The center of the weight located along a contour of a lwpolyline.
 Without arc segments.
Code: [Select]
(defun eea-centroid-curve-pl (pl / L)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

The center of the weight located along a contour of a lwpolyline.
 Without arc segments.
As an example, the center of weight of a wire detail

!!! For the closed polylines to add the description of a closing segment.

pl - list point

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
 (if (= (car a) 10)
  (setq pl (cons (cdr a) pl))
 ) ;_  if
) ;_  foreach

(eea-centroid-curve-pl pl)
*****************************************************************************************

(defun c:c5 (/ e bl pl)
 (setq e (car (entsel)))
 (foreach a (reverse (entget e))
  (cond ((= (car a) 10) (setq pl (cons (cdr a) pl)))
        ((= (car a) 42) (setq bl (cons (cdr a) bl)))
  ) ;_  cond
 ) ;_  foreach
 (if (= (cdr (assoc 70 (entget e))) 1)
  (setq pl (reverse (cons (car pl) (reverse pl))))
 ) ;_  if
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-curve-pl pl))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq l 0)
 (mapcar
  (Function /)
  (apply
   (function mapcar)
   (cons
    (function +)
    (mapcar
     (function (lambda (p1 p2 / D)
                (setq d (distance p1 p2)
                      l (+ d l)
                ) ;_  setq
                (mapcar (function (lambda (a b c) (* (/ (+ a b) 2) c))) p1 p2 (list d d))
               ) ;_  lambda
     ) ;_  function
     pl
     (cdr pl)
    ) ;_  mapcar
   ) ;_  cons
  ) ;_  apply
  (list l l)
 ) ;_  mapcar
) ;_  defun

The center of weight, average point, crossing of medians of a triangle
Code: [Select]
(defun eea-centroid-triangle (p1 p2 p3)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

The center of weight, average point, crossing of medians of a triangle

p1 p2 p3 - points triangle

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************
(setq e  (car (entsel "\n Select LWPOLYLINE "))
      pl nil
) ;_  setq
(foreach a (entget e)
 (if (= (car a) 10)
  (setq pl (cons (cdr a) pl))
 ) ;_  if
) ;_  foreach

(eea-centroid-triangle (car pl)(cadr pl)(caddr pl))
*****************************************************************************************

(defun c:c6 (/ e pl)
 (setq e  (car (entsel "\n Select LWPOLYLINE "))
       pl nil
 ) ;_  setq
 (foreach a (entget e)
  (if (= (car a) 10)
   (setq pl (cons (cdr a) pl))
  ) ;_  if
 ) ;_  foreach
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-triangle (car pl) (cadr pl) (caddr pl)))
                 (assoc 210 (entget e))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (mapcar (function (lambda (a b c) (/ (+ a b c) 3))) p1 p2 p3)
) ;_  defun

Centroid (the center of weights) areas, inside of an arc segment of a polyline.
Code: [Select]
(defun eea-centroid-solid-arc (p1 p2 b / BB C)
                              ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) areas, inside of an arc segment of a polyline.

p1 - start segment point
p2 - end segment point
b  - bulge is the tangent of 1/4 of the included angle for the arc segment

Date of creation   2000 - 2008 years.
*****************************************************************************************

(setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
      b  (cdr
          (nth
           (fix
            (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
           ) ;_  fix
           (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
          ) ;_  nth
         ) ;_  cdr
      d  (fix
          (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
         ) ;_  fix
      p1 (vlax-curve-getPointAtParam (car e) d)
      p2 (vlax-curve-getPointAtParam (car e) (1+ d))
) ;_  setq

(eea-centroid-solid-arc p1 p2 b)
*****************************************************************************************

(defun c:c7 (/ e bl pl)
 (setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
       b  (cdr
           (nth (fix (vlax-curve-getParamAtPoint (car e)
                                                 (vlax-curve-getClosestPointTo (car e) (cadr e))
                     ) ;_  vlax-curve-getParamAtPoint
                ) ;_  fix
                (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
           ) ;_  nth
          ) ;_  cdr
       d  (fix
           (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
          ) ;_  fix
       p1 (vlax-curve-getPointAtParam (car e) d)
       p2 (vlax-curve-getPointAtParam (car e) (1+ d))
 ) ;_  setq
 (entmakex (list '(0 . "point")
                 '(62 . 1)
                 (cons 10 (eea-centroid-solid-arc p1 p2 b))
                 (assoc 210 (entget (car e)))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun
*****************************************************************************************

|;
 (setq bb (* b b)
        (distance p1 p2)
       s  (+ (/ (1- bb) (* 4 b))
             (/ (* 2 bb) (* 3 (+ (* (1+ bb) (1+ bb) (atan b)) (* -1 b (1+ bb)) (* 2 b bb))))
          ) ;_  *
 ) ;_  setq
 (mapcar (function (lambda (a b c) (+ (/ (+ a b) 2) c)))
         p1
         p2
         (list (* (- (cadr p2) (cadr p1)) s) (* (- (car p1) (car p2)) s))
 ) ;_  mapcar
) ;_  defun

Centroid (the center of weights) areas, located along a contour of a segment of a polyline.
Code: [Select]
(defun eea-centroid-curved-arc (p1 p2 b / S)
 ;|
*****************************************************************************************

by ElpanovEvgeniy

*****************************************************************************************

Library function.

Centroid (the center of weights) areas, located along a contour of a segment of a polyline.
As an example, the center of weight of a wire detail

p1 - start segment point
p2 - end segment point
b  - bulge is the tangent of 1/4 of the included angle for the arc segment

Date of creation   2000 - 2005 years.
Last edit 08.06.2009
*****************************************************************************************

(setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
      b  (cdr
          (nth
           (fix
            (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
           ) ;_  fix
           (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
          ) ;_  nth
         ) ;_  cdr
      d  (fix
          (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
         ) ;_  fix
      p1 (vlax-curve-getPointAtParam (car e) d)
      p2 (vlax-curve-getPointAtParam (car e) (1+ d))
) ;_  setq

    
(eea-centroid-curved-arc p1 p2 b)

*****************************************************************************************

(defun c:c8 (/ e bl pl)
 (setq e  (entsel "\n Specify a polyline, in the necessary arc segment...")
       b  (cdr
           (nth (fix (vlax-curve-getParamAtPoint (car e)
                                                 (vlax-curve-getClosestPointTo (car e) (cadr e))
                     ) ;_  vlax-curve-getParamAtPoint
                ) ;_  fix
                (vl-remove-if-not (function (lambda (x) (= (car x) 42))) (entget (car e)))
           ) ;_  nth
          ) ;_  cdr
       d  (fix
           (vlax-curve-getParamAtPoint (car e) (vlax-curve-getClosestPointTo (car e) (cadr e)))
          ) ;_  fix
       p1 (vlax-curve-getPointAtParam (car e) d)
       p2 (vlax-curve-getPointAtParam (car e) (1+ d))
 ) ;_  setq
 (entmakex (list '(0 . "point")
                 '(62 . 2)
                 (cons 10 (eea-centroid-curved-arc p1 p2 b))
                 (assoc 210 (entget (car e)))
           ) ;_  list
 ) ;_  entmakex
) ;_  defun

*****************************************************************************************
|;
 (setq s (- (/ 1 (* 4 (atan b))) (/ (- 1 (* b b)) (* 4 b))))
 (mapcar (function (lambda (a b c) (+ (/ (+ a b) 2) c)))
         p1
         p2
         (list (* (- (cadr p2) (cadr p1)) s) (* (- (car p1) (car p2)) s))
 ) ;_  mapcar
) ;_  defun
My argument has always been that we need to learn how to ask questions as much as we need to learn to solve problems. /Kerry Brown/