平面点集闭合回路

aimisiyou

(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) plst nil)
    (while (< i n)
        (setq plst (cons (cdr (assoc 10 (entget (ssname sn i)))) plst))
         (setq i (+ i 1))
    )
    plst
)
(setq plst (fp)  n (length plst) )
(setq pt (list
             (/ (apply '+ (mapcar 'car plst)) n 1.0)
             (/ (apply '+ (mapcar 'cadr plst)) n 1.0)
             (/ (apply '+ (mapcar 'caddr plst)) n 1.0)
           )
)
(setq ptlst (mapcar '(lambda (p)
                             (list
                                (angle pt p)
                                (distance pt p)
                                (car p)
                                (cadr p)
                              )
                       )
                       plst                     
               )
)
(setq pplst (vl-sort ptlst '(lambda (a b)
                                    (if  (= (car a) (car b))
                                         (>= (cadr a) (cadr b))
                                         (< (car a) (car b))
                                     )
                              )
             )
)
(setq pts (mapcar '(lambda (c) (cdr (cdr c))) pplst))
(apply 'command (cons "pline" (reverse (cons "c" (reverse pts)))))

ynhh

感谢大师
这用在什么地方啊

HLCAD

感谢大师分享程序！！！

yangjian001

做一个热心并受欢迎的人

aimisiyou

(defun fp ()
    (setq sn (ssget ":N" '((0 . "point"))))
    (setq i 0 n (sslength sn) plst nil)
    (while (< i n)
        (setq plst (cons (cdr (assoc 10 (entget (ssname sn i)))) plst))
         (setq i (+ i 1))
    )
    plst
)
(defun pick (lst i j)
   (setq count (length lst) nc 0 picklst nil)
   (while (<= nc j)
       (if (<= i nc)
           (setq picklst (cons (nth nc lst) picklst))
       )
      (setq nc (+ nc 1))
   )   
   (reverse picklst)
)
(setq plst (fp)  n (length plst) m (/ n 3) )
(setq pt (list
             (/ (apply '+ (mapcar 'car plst)) n 1.0)
             (/ (apply '+ (mapcar 'cadr plst)) n 1.0)
             (/ (apply '+ (mapcar 'caddr plst)) n 1.0)
           )
)
(setq ptlst (mapcar '(lambda (p)
                             (list
                                (angle pt p)
                                (distance pt p)
                                (car p)
                                (cadr p)
                              )
                       )
                       plst                     
               )
)
(setq pplst (vl-sort ptlst '(lambda (a b)
                                         (<= (cadr a) (cadr b))
                              )
             )
)
(setq pflst (pick pplst 0 (- m 1)))
(setq pllst (pick pplst m (- n 1)))
(setq pllst (mapcar '(lambda (v) (list
                                      (- (* pi 4) (car v))
                                      (cadr v)
                                      (caddr v)
                                      (cadddr v)
                                   )
                       )
               pllst
             )
)
(setq pvlst (append pflst pllst))
(setq pvlst (vl-sort pvlst '(lambda (a b)
                                    (if  (= (car a) (car b))
                                         (>= (cadr a) (cadr b))
                                         (< (car a) (car b))
                                     )
                              )
             )
)
(setq pts (mapcar '(lambda (c) (cdr (cdr c))) pvlst))
(apply 'command (cons "pline" (reverse (cons "c" (reverse pts)))))