将矩形排序

caoyin

;;时间关系，只可用于个例

(defun C:TT (/ get-Polyline-Vertexs GET-PTS-BOX RecTang-P SS I EN BOX BOXS)
;;获取多段线顶点列表
(defun get-Polyline-Vertexs (E / I V LST)
  (setq I -1)
  (while (setq V (vlax-curve-getpointatparam E (setq I (1+ I))))
    (setq LST (cons V LST))
  )
)
;;获取点集范围 by 王咣生
(defun GET-PTS-BOX (PTL)
  (list        (apply 'mapcar (cons 'MIN PTL))
        (apply 'mapcar (cons 'MAX PTL))
  )
)
;;判断多段线是否是矩形,是则返回其范围(左下角点和右上角点)
(defun RecTang-P (EN / LST)
  (setq LST (get-Polyline-Vertexs EN))
  (if (apply '= (mapcar '(lambda (A B) (distance A B)) LST (cddr LST)))
    (GET-PTS-BOX LST)
  )
)
;;求中点
(defun midpoint (p1 p2) (mapcar '(lambda (x y) (/ (+ x y) 2.0)) p1 p2))
(if (setq SS (ssget '((0 . "*POLYLINE"))))
  (progn
    (repeat (setq I (sslength SS))
      (setq EN   (ssname SS (setq I (1- I))))
               ;;排除非矩形对象
      (if (and (setq BOX (RecTang-P EN))
               ;;如该矩形中不包含对象则被忽略
               (> (sslength (apply 'ssget (cons "W" BOX))) 1)
          )
        (setq BOXS (cons BOX BOXS))
      )
    )
    (foreach X BOXS (grvecs (cons 1 X)))
    (setq LST (mapcar '(lambda (X) (apply 'midpoint X)) BOXS)
         LST (vl-sort LST '(lambda (X Y) (< (car X) (car Y)))
    ))
    (setq I 0)
    (repeat (/ (length LST) 2)
      (foreach X
       (vl-sort (list (nth I LST) (nth (1+ I) LST))
                '(lambda (X Y) (< (cadr X) (cadr Y)))
       )
       (entmake (list '(0 . "text")
               (cons 10 X)
               '(40 . 20)
               (cons 1 (itoa (setq I (1+ I))))
               )
       )
     )
   )
)))

啵浪鼓

回复 caoyin 的帖子

C版太强了，就是这种效果了，厉害，膜拜啊!

yhkk0317

回复 caoyin 的帖子

这个程序对于我来说也很实用．谢谢．