Великому и могучему языку посвящается...

Новая версия сайта, доступна здесь.

Центроид

Центроид (центр масс) области, внутри полилинии, имеющей дуговые сегменты.

Центр массы, расположенной вдоль контура полилинии, имеющей дуговые сегменты.

Средняя точка - центр массы, расположенной в вершинах полилинии равными частями

Центроид (центр масс) области, внутри многоугольника

Центр массы, расположенной вдоль контура полилинии, без дуговых сегментов.

Центр массы, средняя точка, пересечение медиан треугольника

Центроид (центр масс) области, внутри дугового сегмента полилинии.

Центроид (центр масс) области, расположенной вдоль контура дугового сегмента полилинии.

Центроид (центр масс) области, внутри полилинии, имеющей дуговые сегменты.

(defun eea-centroid-solid-lw (pl bl / A1)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Центроид (центр масс) области, внутри полилинии, имеющей дуговые сегменты.

pl - список вершин полилинии (код 10)
bl - список тангенсов четверти угла дуговых сегментов полилинии (код 42)

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Наверх

Центр массы, расположенной вдоль контура полилинии, имеющей дуговые сегменты.

(defun eea-centroid-curve-lw (pl bl / L)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Центр массы, расположенной вдоль контура полилинии, имеющей дуговые сегменты.
Как пример, центр массы проволочной детали

pl - список вершин полилинии (код 10).
bl - список тангенсов четверти угла дуговых сегментов полилинии (код 42)

!!!  для замкнутых полилиний, добавить описание замыкающего сегмента.

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Наверх

Средняя точка - центр массы, расположенной в вершинах полилинии равными частями.

(defun eea-centroid-point-lw (pl)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Средняя точка - центр массы, расположенной в вершинах полилинии равными частями

pl - список вершин полилинии (код 10).

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Наверх

Центроид (центр масс) области, внутри многоугольника.

(defun eea-centroid-solid-pl (pl)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Центроид (центр масс) области, внутри многоугольника

pl - список вершин полилинии (код 10)

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Наверх

Центр массы, расположенной вдоль контура полилинии, без дуговых сегментов.

(defun eea-centroid-curve-pl (pl / L)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Центр массы, расположенной вдоль контура полилинии, без дуговых сегментов.
Как пример, центр массы проволочной детали

pl - список вершин полилинии (код 10).

!!!  для замкнутых полилиний, добавить описание замыкающего сегмента.

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Наверх

Центр массы, средняя точка, пересечение медиан треугольника.

(defun eea-centroid-triangle (p1 p2 p3)
                             ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Центр массы, средняя точка, пересечение медиан треугольника

p1 p2 p3 - вершины треугольника

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Наверх

Центроид (центр масс) области, внутри дугового сегмента полилинии.

(defun eea-centroid-solid-arc (p1 p2 b / BB C)
                              ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Центроид (центр масс) области, внутри дугового сегмента полилинии.


p1 - начальная точка дугового сегмента
p2 - конечная точка дугового сегмента
b  - кривизна дугового сегмента (тангенс четверти центрального угла дуги).

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Наверх

Центроид (центр масс) области, расположенной вдоль контура дугового сегмента полилинии.

(defun eea-centroid-curved-arc (p1 p2 b / S)
 ;; centroid arc segment
 ;|
*****************************************************************************************

by ElpanovEvgeniy

Библиотечная функция, 

Центроид (центр масс) области, расположенной вдоль контура сегмента полилинии.


p1 - начальная точка дугового сегмента
p2 - конечная точка дугового сегмента
b  - кривизна дугового сегмента (тангенс четверти центрального угла дуги).

Дата создания      2000 - 2005 годы
Последняя редакция 08.06.2009
*****************************************************************************************

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

Powered by MODx cms