TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ronjonp on November 04, 2004, 11:40:22 AM

Title: Centroid Lisp
Post by: ronjonp on November 04, 2004, 11:40:22 AM
Do any of you have a lisp that will give you the centroid of a closed polyline?

Thanks,

Ron
Title: Centroid Lisp
Post by: hendie on November 04, 2004, 11:46:41 AM
the CENT routine over at www.resourcecad.com can place a point at the centroid if it's a region. a closed polyline doesn't have a centroid property as such
is that what you're after or are you looking for a lisp which will return the centroid as data coordinates ?
Title: Centroid Lisp
Post by: CAB on November 04, 2004, 11:51:08 AM
Code: [Select]
;; ******************************************************************************
;; Determine centroid of a polygon
;;
;; Algorithm:
;; 1. Form trapezoids by dropping lines from each segment to a basey axis.
;; 2. Calculate the area and CG of the triangle and rectangle in each trapezoid
;; 3. Sums up weighted moments against given axes in X and Y direction
;;    (may use x and y axes if number is small)
;; 4. Derived CG by dividing weighted sum by total area.
;; ******************************************************************************

(defun GE_centroid(vlist / segno n ttl_area basex basey p1 p2 x1 x2 y1 y2
t_x t_y t_area t_xm t_ym r_x r_y r_area r_xm r_ym Mx My)
(setq
vlist (append vlist (list (car vlist)))
segno (1- (length vlist))    ; no of segments
n 0
Ttl_Area 0.0 ; total area
Mx 0.0 ; Sum of moment to basex line
My 0.0 ; Sum of moment to basey line
basex (car  (nth 0 vlist)) ; arbitrary axes (will reduce error for large numbers)
basey (cadr (nth 0 vlist))
)

(repeat segno
(setq
p1 (nth n vlist) ; process current segment
p2 (nth (1+ n) vlist)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)

; For the triangle
t_x (- (* (+ x2 x2 x1) 0.333333) basex) ; cg of trianlge
t_y (- (* (+ y1 y1 y2) 0.333333) basey)
t_area (* (- y2 y1) (- x2 x1) 0.5) ; area of triangle
t_xm (* t_area t_x) ; moment to Basex
t_ym (* t_area t_y) ; moment to basey

; For the rectangle
r_x (- (/ (+ x1 x2) 2) basex) ; CG of rectangle
r_y (- (/ (+ basey y1) 2) basey)
r_area (* (- x2 x1) (- y1 basey)) ; area of rectangle
r_xm (* r_area r_x) ; moment to basex
r_ym (* r_area r_y) ; moment to basey

Ttl_Area (+ Ttl_Area t_area r_area)
Mx (+ Mx  t_xm r_xm) ; adds up moments to basex
My (+ My  t_ym r_ym) ; adds up moments to basey
n (1+ n)
)
)
(list (+ (/ Mx Ttl_Area) basex) (+ (/ My Ttl_Area) basey))
)
Title: Centroid Lisp
Post by: ronjonp on November 04, 2004, 12:04:01 PM
thanks guys.  :D
Title: Re: Centroid Lisp
Post by: Aldo on May 10, 2019, 01:50:54 PM
I found it on the web, I hope it's of your use




(defun c:pc ( / acdoc acspc acsel pl bl ) (vl-load-com)
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
 )
 (if (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))
   (progn
     (vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc))
       (vlax-invoke acspc 'addpoint
         (trans
           (progn
             (setq pl nil bl nil)
             (foreach a (reverse (entget (vlax-vla-object->ename obj)))
               (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)
        [color="red"]  (reverse(cons (vla-get-elevation obj)(reverse (eea-centroid-solid-lw pl bl))));;;VVA MOD 2015-03-29[/color]
             )
           1 0)
       )
     )
     (vla-delete acsel)
   )
 )
 (princ)
)

(defun eea-centroid-solid-lw (pl bl / A1)
;|
***********************************************************************
by ElpanovEvgeniy
Library function,
Centroids (center of masses) of region, inside [polilinii], which has arched segments.
pl - list of the apexes of [polilinii] (code 10)
bl - list of tangents fourth of angle of the arched segments of [polilinii] (code 42)
Date of the creation      2000 - 2005
Last editorial staff 08.06.2009
URL http://elpanov.com/index.php?id=46

*********************************************************************
Library of function.
Centroid (the of center of of weights) of region, inside of a of polyline, having of arc of segments
pl - list of point
bl - list of bulge
Date of of creation   2000 - 2005 years.
Last of 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
Title: Re: Centroid Lisp
Post by: gile on May 10, 2019, 02:53:11 PM
Hi,

See this topic (http://www.theswamp.org/index.php?topic=18725).
Title: Re: Centroid Lisp
Post by: ribarm on May 11, 2019, 10:30:38 AM
Just for your info, centroid point can be from mass - 3DSOLID centroid, from area - REGION centroid and from curve - open/closed which is not documented by AutoCAD... I just happen to have the one that determines ARC centroid of arc as curve and area of chord and area of circle segment... For LWPOLYLINE with arcs it would be easy to find, just obtain from each arc like described in the code and from linear segments it's at middle of each line... Then you sum all X coords multiplied with each segments lengths and divide by total length of LWPOLYLINE for X centroid coord and the same for Y... The problem are splines as curves - not areas as if they are closed they could be converted to REGIONS and get area centroids - the problem is curve centroid - that is even now for me unknown... And beside all this even CAD can make small miscalculations with area and mass centroids : sometimes - (vla-get-centroid) is different than "gcen" OSNAP and MASSPROP centroid claculation... So here is for ARC if you are still interested :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:arccentroid ( / arc c r a d1 d2 d3 p cen1 cen2 cen3 )
  2.  
  3.  
  4.  (while (or (not (setq arc (car (entsel "\nPick an arc...")))) (if arc (/= (cdr (assoc 0 (entget arc))) "ARC")))
  5.    (prompt "\nMissed or picked wronf entity type...")
  6.  )
  7.  (setq c (cdr (assoc 10 (entget arc))))
  8.  (setq r (cdr (assoc 40 (entget arc))))
  9.  (setq a (rem (+ pi pi (- (cdr (assoc 51 (entget arc))) (cdr (assoc 50 (entget arc))))) (+ pi pi)))
  10.  (setq d1 (/ (* 4.0 r (expt (sin (/ a 2.0)) 3)) (* 3.0 (- a (sin a)))))
  11.  (setq d2 (/ (* r (sin (/ a 2.0))) (/ a 2.0)))
  12.  (setq d3 (/ (* 2.0 r (sin (/ a 2.0))) (* 3.0 (/ a 2.0))))
  13.  (setq cen1 (mapcar '+ (trans c arc 0) (mapcar '(lambda ( x ) (* (/ x (distance (trans c arc 0) p)) d1)) (mapcar '- p (trans c arc 0)))))
  14.  (setq cen2 (mapcar '+ (trans c arc 0) (mapcar '(lambda ( x ) (* (/ x (distance (trans c arc 0) p)) d2)) (mapcar '- p (trans c arc 0)))))
  15.  (setq cen3 (mapcar '+ (trans c arc 0) (mapcar '(lambda ( x ) (* (/ x (distance (trans c arc 0) p)) d3)) (mapcar '- p (trans c arc 0)))))
  16.  (entmake (list '(0 . "POINT") (cons 10 cen1) '(62 . 1)))
  17.  (entmake (list '(0 . "LINE") (cons 10 (vlax-curve-getstartpoint arc)) (cons 11 (vlax-curve-getendpoint arc)) '(62 . 1)))
  18.  (entmake (list '(0 . "POINT") (cons 10 cen2) '(62 . 2)))
  19.  (entmake (list '(0 . "POINT") (cons 10 cen3) '(62 . 3)))
  20.  (entmake (list '(0 . "LINE") (cons 10 (vlax-curve-getstartpoint arc)) (cons 11 (trans c arc 0)) '(62 . 3)))
  21.  (entmake (list '(0 . "LINE") (cons 10 (vlax-curve-getendpoint arc)) (cons 11 (trans c arc 0)) '(62 . 3)))
  22.  (princ)
  23. )
  24.  

HTH., M.R.
Title: Re: Centroid Lisp
Post by: notredave on May 15, 2019, 08:17:35 AM
Aldo or anybody,

Good morning. Can someone tell me a way to make Aldo's lisp routine tell me c:pc when loaded to execute. I named this lisp "centroid.lsp" to know what it is but when I load it, it tells me "EEA-CENTROID-SOLID-LW"

Thank you very much in advance,
David
Title: Re: Centroid Lisp
Post by: ronjonp on May 15, 2019, 08:58:12 AM
Quick glance and you need to remove [color="red"] from the code.
Title: Re: Centroid Lisp
Post by: MSTG007 on May 15, 2019, 09:15:39 AM
I gonna ask. What are wanting to do? Curious. I know....
Title: Re: Centroid Lisp
Post by: notredave on May 15, 2019, 09:32:16 AM
MSTG007,

I would like to know after I load centroid.lsp, what command to execute? Currently it comes back with EEA-CENTROID-SOLID-LW after loaded but looking at lisp, it says (defun c:pc...
I want it to return with pc to start lisp.

Thank you,
David
Title: Re: Centroid Lisp
Post by: Lee Mac on May 15, 2019, 12:29:38 PM
MSTG007,

I would like to know after I load centroid.lsp, what command to execute? Currently it comes back with EEA-CENTROID-SOLID-LW after loaded but looking at lisp, it says (defun c:pc...
I want it to return with pc to start lisp.

Thank you,
David

'pc' is the command which may be used to invoke the program at the command-line, as this function has been defined with a 'c:' prefix; EEA-CENTROID-SOLID-LW is returned at the command-line after loading because this is the value returned by the last expression evaluated by the load function when the AutoLISP file is loaded, i.e. the value returned by the defun expression - if you don't want to see this returned at the command-line on loading, simply add (princ) on a new line at the very end of the file.
Title: Re: Centroid Lisp
Post by: notredave on May 15, 2019, 01:26:14 PM
Lee,

Thank you very much for your response. I put (princ) at the end and that worked. What I'm asking is that after I load centroid.lsp that it returns with c:PC to let me know what invokes it.

Thank you,
David
Title: Re: Centroid Lisp
Post by: Lee Mac on May 15, 2019, 01:44:17 PM
Thank you very much for your response. I put (princ) at the end and that worked. What I'm asking is that after I load centroid.lsp that it returns with c:PC to let me know what invokes it.

No problem - add something like the following to the end of the file:
Code: [Select]
(princ "\nType 'PC' to invoke the program.")
(princ)

Alternatively, remove the final (princ) and reorder the two defun expressions.

Title: Re: Centroid Lisp
Post by: notredave on May 15, 2019, 01:55:23 PM
Thank you very much Lee!!! That did the trick. I appreciate you.

David
Title: Re: Centroid Lisp
Post by: BIGAL on May 16, 2019, 11:36:42 PM
If you want to hit them in the face change the princ in Lee's code to Alert. You can also add extra lines if you want also.

Code: [Select]
(princ "\nType 'PC' to invoke the program.")

(alert "Type 'PC' to invoke the program.\n\nDont forget abot the other options\nA or B\n Folowed by C")