排序

rln007

感谢liu_kunlun大侠无私奉献，强烈感谢

rln007

测试一下，有如下问题，出错如附件1，想得到的为附件2，其中圆1-2，2-3，3-4，1-4，4-5，3-6，5-6等距离相等

liu_kunlun

(defun c:ttt ( / ss pt ss1 out n fid x y h)
(if (and (setq ss (ssget '((0 . "CIRCLE"))))
  (setq pt (getpoint "起点:"))
  (setq h (getdist pt "文字高度:"))
    )
    (progn
       (setq ss1 nil out nil)
       (setq n -1)
       (repeat (sslength ss) (setq ss1 (cons (ssname ss (setq n (+ n 1)) ) ss1)))      
       (setq ss1 (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ss1))
      
       (setq out (list (cons 0 pt)) n 0)      
       (while ss1
   (setq ss1 (vl-sort ss1 '(lambda (x y) (if (= (distance (cdr (car out)) (list (car x)(cadr x) 0))
                                                       (distance (cdr (car out)) (list (car y)(cadr y) 0))
                                                    )
                                                    (> (abs (- (caar out) (car x))) (abs (- (caar out) (car y))))
                                                    (< (distance (cdr (car out)) (list (car x)(cadr x) 0))
                                                       (distance (cdr (car out)) (list (car y)(cadr y) 0))
                                                    )
          )         )              )            )
          (setq out (cons (cons (setq n (+ n 1)) (car ss1)) out)
                ss1 (cdr ss1)
       )  )
       (setq out (cdr (reverse out)))
       (setq fid (open "c:\\test.txt" "w"))
       (foreach x out
   (entmake (list '(0 . "TEXT") (cons 10 (cdr x)) (cons 1 (itoa (car x))) (cons 40 h)))
   (write-line (strcat (itoa (car x)) "," (rtos (cadr x) 2 3) "," (rtos (caddr x) 2 3)  "," (rtos (cadddr x) 2 3)) fid)
       )
       (close fid)
)  )
)

rln007

再次感谢liu_kunlun大侠无私奉献，还是有点小问题，如图

luyu9635

xianaihua发表于2009-11-26 0:37:00luyu9635：不明白你的意思。是标号排序还是，图形变换？

 是对图形排序,如rln所说找最短路径,因为在做切割的时候是按画图的先后进行的,无序的,所以想通过程序重排序,按最短路径切割,就很有用了,我不需要标号,只要实际顺序变成想要的效果就行,liu-kunlun的程序还没测试,不知在图形多的时候,速度如何,如果速度跟不上,实际意义也就不大了

liu_kunlun

rln007：关键是你的规则要确定好，编程只是实现。

(defun c:ttt ( / ss pt ss1 out n fid x y h)
(if (and (setq ss (ssget '((0 . "CIRCLE"))))
  (setq pt (getpoint "起点:"))
  (setq h (getdist pt "文字高度:"))
    )
    (progn
       (setq ss1 nil out nil)
       (setq n -1)
       (repeat (sslength ss) (setq ss1 (cons (ssname ss (setq n (+ n 1)) ) ss1)))      
       (setq ss1 (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ss1))
      
       (setq out (list (cons 0 pt)) n 0)      
       (while ss1
   (setq ss1 (vl-sort ss1 '(lambda (x y) (if (equal (distance (cdr (car out)) (list (car x)(cadr x) 0))
                                                       (distance (cdr (car out)) (list (car y)(cadr y) 0)) 0.1
                                                    )
                                                    (> (abs (- (caar out) (car x))) (abs (- (caar out) (car y))))
                                                    (< (distance (cdr (car out)) (list (car x)(cadr x) 0))
                                                       (distance (cdr (car out)) (list (car y)(cadr y) 0))
                                                    )
          )         )              )            )
          (setq out (cons (cons (setq n (+ n 1)) (car ss1)) out)
                ss1 (cdr ss1)
       )  )
       (setq out (cdr (reverse out)))
       (setq fid (open "c:\\test.txt" "w"))
       (foreach x out
   (entmake (list '(0 . "TEXT") (cons 10 (cdr x)) (cons 1 (itoa (car x))) (cons 40 h)))
   (write-line (strcat (itoa (car x)) "," (rtos (cadr x) 2 3) "," (rtos (caddr x) 2 3)  "," (rtos (cadddr x) 2 3)) fid)
       )
       (close fid)
)  )
)

rln007

感谢liu_kunlun大侠,规则就是s形，就是图片中6号和10号位置互换，更新的程序好像还是同样的问题，程序拐上去后想让它往左，测试结果是往上走到头后才往左

liu_kunlun

是有点问题。

(defun c:ttt ( / ss pt ss1 out n fid x y h)
(if (and (setq ss (ssget '((0 . "CIRCLE"))))
  (setq pt (getpoint "起点:"))
  (setq h (getdist pt "文字高度:"))
    )
    (progn
       (setq ss1 nil out nil)
       (setq n -1)
       (repeat (sslength ss) (setq ss1 (cons (ssname ss (setq n (+ n 1)) ) ss1)))      
       (setq ss1 (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ss1))
      
       (setq out (list (cons 0 pt)) n 0)      
       (while ss1
   (setq ss1 (vl-sort ss1 '(lambda (x y) (if (equal (distance (cdr (car out)) (list (car x)(cadr x) 0))
                                                    (distance (cdr (car out)) (list (car y)(cadr y) 0)) 0.1
                                             )
                                             (> (abs (- (cadar out) (car x))) (abs (- (cadar out) (car y))))
                                             (< (distance (cdr (car out)) (list (car x)(cadr x) 0))
                                                (distance (cdr (car out)) (list (car y)(cadr y) 0))
                                             )
          )         )              )     )
          (setq out (cons (cons (setq n (+ n 1)) (car ss1)) out)
                ss1 (cdr ss1)
       )  )
       (setq out (cdr (reverse out)))
       (setq fid (open "c:\\test.txt" "w"))
       (foreach x out
   (entmake (list '(0 . "TEXT") (cons 10 (cdr x)) (cons 1 (itoa (car x))) (cons 40 h)))
   (write-line (strcat (itoa (car x)) "," (rtos (cadr x) 2 3) "," (rtos (caddr x) 2 3)  "," (rtos (cadddr x) 2 3)) fid)
       )
       (close fid)
)  )
)

rln007

向liu_kunlun大侠致敬，还有如图所示的问题

liu_kunlun

rln007:

到rln007@sohu.com中去取