TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: gile 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).
(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 (http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=16670#pid)
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.
;; 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 :
;; 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)
)
-
Greetings gile! :-)
Very good and necessary work.
Thanks for share...
PS. On Monday, I shall understand with the program - I liked its some parts...
-
Thanks Evgeniy,
Some more explainations :
The algorythm (from Joseph O'Rourke ?) to get a polygon centroid is discribed here (http://www.cgafaq.info/wiki/Polygon_Centroid)
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)
-
hi guys, i'm interested in this matter. How do i run these routines in order to locate the centroid of closed polylines?
-
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) :
(pline-centroid (car (entsel)))
Or use the PT-CEN command which create a point on the selected pline centroid :
;; 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)
)
-
this one is for happy Autodesk Map users :)
(ade_expreval (car (entsel)) ".CENTER" "POINT")
-
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 (http://66.196.80.202/babelfish/translate_url_content?.intl=us&lp=ru_en&trurl=http%3a%2f%2felpanov.com%2findex.php%3fid%3d46)
Rus (http://elpanov.com/index.php?id=46)
-
Centroid (the center of weights) region, inside of a polyline, having arc segments
(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.
(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
(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.
(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.
(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
(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.
(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.
(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
-
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
-
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.
-
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
(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.
(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
(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.
(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.
(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
(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.
(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.
(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