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