[编程交流] 开放多边形的重心

(defun c:cgpline (/ dst lst mdp mdx mdy ss x y en pt)
 (if
   (setq ss (ssget ":E:S:L" '((0 . "LWPOLYLINE"))))
    (progn
      (setq lst (mapcar 'cdr
                        (vl-remove-if
                          '(lambda (x) (/= (car x) 10))
                          (setq en (entget (ssname ss 0)))
                        )
                )
            dst (mapcar 'distance lst (cdr lst))
            mdp (mapcar '(lambda (x y)
                           (mapcar '(lambda (a b) (* 0.5 (+ a b))) x y)
                         )
                        lst
                        (cdr lst)
                )
            mdx (mapcar 'car mdp)
            mdy (mapcar 'cadr mdp)
            x   (/ (apply '+ (mapcar '* mdx dst)) (apply '+ dst))
            y   (/ (apply '+ (mapcar '* mdy dst)) (apply '+ dst))
            pt  (trans (list x
                             y
                             (cond ((cdr (assoc 38 en)))
                                   (0.0)
                             )
                       )
                       (trans '(0. 0. 1.) (cdr (assoc 210 en)) 0 T)
                       0
                )
      )
      (entmake (list '(0 . "POINT") (cons 10 pt)))
    )
 )
 (princ)
)

(defun c:TesT (/ pl i sn e lst pts n i x y)
 ;;; Tharwat 12. Dec. 2011 ;;
 (if (setq pl (ssget '((0 . "*POLYLINE"))))
   (repeat (setq i (sslength pl))
     (setq sn (ssname pl (setq i (1- i))))
     (setq e (entget sn))
     (setq lst (vl-remove-if-not
                 (function (lambda (x)
                             (if (eq (car x) 10)
                               (setq pts (cons (list (cadr x) (caddr x)) pts))
                             )
                           )
                 )
                 e
               )
     )
     (setq i 0 x 0 y 0 )
     (repeat (setq n (length pts))
       (setq x (+ (car (nth i pts)) x))
       (setq y (+ (cadr (nth i pts)) y))
       (setq i (1+ i))
     )
     (entmake (list '(0 . "POINT") (cons 10 (list (/ x (length pts)) (/ y (length pts))))))
   )
   (princ)
 )
 (princ)
)

(setq lst (vl-remove-if-not
           (function (lambda (x)
                       (if (eq (car x) 10)
                         (setq pts (cons (list (cadr x) (caddr x)) pts))
                       )
                     )
           )
           e
         )
)

(foreach pair (entget <entity>)
   (if (= 10 (car pair))
       (setq pts (cons (cdr pair) pts))
   )
)

(mapcar
       (function
         (lambda (x)
           (if (eq (car x) 10)
             (setq pts (cons (list (cadr x) (caddr x)) pts))
           )
         )
       )
       e
     )

6