图框位置（图幅位置）排序函数

USER2128 · 发表于 2025-6-18 08:15:55

;;;---------------------------------------------;;;
;;; 图框位置（图幅位置）排序函数（HLCAD/USER2128，2025-6-17）
;;; 函数主要用于多个图幅集合图纸的排序.
;;; 参数: pt_lst = '((图幅1左下点图幅1右上点图幅1比例 ... ) ... )
;;; 返回: 已排序后的总表(格式同pt_lst).
(defun sort_pt_lst (pt_lst / BOX BOX$ LST$ MAX$ TAKE TF-LST TMP
HL:PtInorOut4Box tmp:take )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 判断Pt点是否在LL，UR的矩形框内.
;;; 如果Pt在框内，或边线上，返回:T.
;;; 参数LL，UR仅是矩形对角两点就行.
;;; EX: (HL:PtInorOut4Box (getpoint"\n测点:")(getpoint"\n角点1:")(getpoint"\n角点2:"))
(defun HL:PtInorOut4Box (Pt LL UR)
(vl-every '>= (mapcar '* (mapcar '- Pt LL) (mapcar '- UR Pt)) '(0 0))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 从图幅集Lst中提取box区域中所包含的所有图幅:
;;; 返回(box区域中所含图幅表剩余Lst中的图幅表)
(defun tmp:take (box Lst / Loop Rest take tmp)
(setq take nil)
(setq Rest Lst)
(setq Loop t)
(while Loop
(setq tmp (mapcar '(lambda(x)
(cond
((and (apply 'HL:PtInorOut4Box (cons (cadr x) box)) ;右上点.
(apply 'HL:PtInorOut4Box (cons (car x) box)) ;左下点.
)
(setq take (cons x take))
nil) ;完全包含.
((apply 'HL:PtInorOut4Box (cons (cadr x) box)) ;右上点.
(setq box (list (cons (caar box) (cdar x)) (cadr box)))
(setq take (cons x take))
nil) ;图幅向下凸出.
(t x)
)) Rest))
(setq tmp (vl-remove 'nil tmp))
(if (> (length Rest) (length tmp))
(setq Rest tmp)
(setq Loop nil)
)
)
(list take Rest)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 计算所有图幅集合所在区域的左下点、右上点:
(setq max$ (mapcar '(lambda(a b) (apply 'mapcar(cons a b)))
'(min max)
(list (mapcar 'car pt_lst) (mapcar 'cadr pt_lst))
))
;;; 按右上角点的Y值最大在前（Y值相同,大图在前）进行排序:
(setq pt_lst (vl-sort pt_lst
'(lambda (a b)
(if (equal (cadadr a) (cadadr b))
(< (cadar a) (cadar b))
(> (cadadr a) (cadadr b))
))))
(setq Lst$ pt_lst)
(setq tf-Lst '())
(while Lst$
;;; 提取顶行所包含的所有图幅:
(setq box$ (list (caar Lst$) (cadar Lst$)))
(setq box$ (list (cons (caar max$) (cdar box$))
(cons (caadr max$) (cdadr box$))
))
(setq tmp (tmp:take box$ Lst$))
(setq tf-Lst (append tf-Lst (list (car tmp))))
(setq Lst$ (cadr tmp))
)
;;; 对各行图幅排序: 左先、上前
(setq tmp (mapcar '(lambda(x) (vl-sort x '(lambda (a b)
(cond
((equal (* (+ (caadr a) (caar a)) 0.5) ;X值中位.
(* (+ (caadr b) (caar b)) 0.5)
(* (- (caadr a) (caar a)) 0.5) ;误差=X差值的一半.
)
(> (cadar a) (cadar b)) ;y值大者放前.
)
(t (< (caar a)(caar b))) ;x值小者放前.
)))) tf-Lst))
(setq tf-Lst (apply 'append tmp))
)
;;;---------------------------------------------;;;
;;; 函数sort_pt_lst测试程序（采用"函数Sort_pt_Lst.dwg"文件测试）:
(defun c:tt (/ Lst pts ss str tmp)
(vl-cmdf "_.zoom" "_e")
(setq SS (ssget "x" '((0 . "LWPOLYLINE") (8 . "02")))) ;图中所有图幅边框.
(setq Lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))))
(setq pts (mapcar '(lambda(x / tmp) ;各图幅边框的(左下点右上点).
(setq tmp (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget x))))
(list (car tmp) (caddr tmp))
) Lst))
(setq str (mapcar '(lambda(x / tmp) ;各图幅中标识字符（仅单个字符）.
(setq tmp (ssget "_c" (car x) (cadr x) '((0 . "TEXT"))))
(cdr (assoc 1 (entget (ssname tmp 0))))
) pts))
(setq Lst (mapcar '(lambda(x y) (append x (list y))) pts str))
(setq Lst (sort_pt_lst Lst))
(mapcar 'caddr Lst)
)
;;;---------------------------------------------;;;

;;;---------------------------------------------;;; 
;;; 图框位置（图幅位置）排序函数（HLCAD/USER2128，2025-6-17） 
;;; 函数主要用于多个图幅集合图纸的排序. 
;;; 参数: pt_lst = '((图幅1左下点 图幅1右上点 图幅1比例 ... ) ... ) 
;;; 返回: 已排序后的总表(格式同pt_lst). 
(defun sort_pt_lst (pt_lst / BOX BOX$ LST$ MAX$ TAKE TF-LST TMP 
        HL:PtInorOut4Box tmp:take ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; 判断Pt点是否在LL，UR的矩形框内. 
;;; 如果Pt在框内，或边线上，返回:T. 
;;; 参数LL，UR仅是矩形对角两点就行. 
;;; EX: (HL:PtInorOut4Box (getpoint"\n测点:")(getpoint"\n角点1:")(getpoint"\n角点2:")) 
(defun HL:PtInorOut4Box (Pt LL UR) 
  (vl-every '>= (mapcar '* (mapcar '- Pt LL) (mapcar '- UR Pt)) '(0 0)) 
  ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; 从图幅集Lst中提取box区域中所包含的所有图幅: 
;;; 返回(box区域中所含图幅表 剩余Lst中的图幅表) 
(defun tmp:take (box Lst / Loop Rest take tmp) 
  (setq take nil) 
  (setq Rest Lst) 
  (setq Loop t) 
  (while Loop 
    (setq tmp (mapcar '(lambda(x) 
      (cond 
  ((and (apply 'HL:PtInorOut4Box (cons (cadr x) box)) ;右上点. 
        (apply 'HL:PtInorOut4Box (cons (car  x) box)) ;左下点. 
        ) 
   (setq take (cons x take)) 
   nil) ;完全包含. 
  ((apply 'HL:PtInorOut4Box (cons (cadr x) box)) ;右上点. 
   (setq box (list (cons (caar box) (cdar x)) (cadr box))) 
   (setq take (cons x take)) 
   nil) ;图幅向下凸出. 
  (t x) 
  )) Rest)) 
    (setq tmp (vl-remove 'nil tmp)) 
    (if (> (length Rest) (length tmp)) 
      (setq Rest tmp) 
      (setq Loop nil) 
      ) 
    ) 
  (list take Rest) 
  ) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; 计算所有图幅集合所在区域的左下点、右上点: 
  (setq max$ (mapcar '(lambda(a b) (apply 'mapcar(cons a b))) 
         '(min max) 
         (list (mapcar 'car pt_lst) (mapcar 'cadr pt_lst)) 
         )) 
;;; 按右上角点的Y值最大在前（Y值相同,大图在前）进行排序: 
  (setq pt_lst (vl-sort pt_lst 
  '(lambda (a b) 
  (if (equal (cadadr a) (cadadr b)) 
    (< (cadar  a) (cadar  b)) 
    (> (cadadr a) (cadadr b)) 
    )))) 
  (setq Lst$ pt_lst) 
  (setq tf-Lst '()) 
  (while Lst$ 
;;; 提取顶行所包含的所有图幅: 
    (setq box$ (list (caar Lst$) (cadar Lst$))) 
    (setq box$ (list (cons (caar  max$) (cdar  box$)) 
         (cons (caadr max$) (cdadr box$)) 
         )) 
    (setq tmp (tmp:take box$ Lst$)) 
    (setq tf-Lst (append tf-Lst (list (car tmp)))) 
    (setq Lst$ (cadr tmp)) 
    ) 
;;; 对各行图幅排序: 左先、上前 
  (setq tmp (mapcar '(lambda(x) (vl-sort x '(lambda (a b) 
      (cond 
  ((equal (* (+ (caadr a) (caar a)) 0.5) ;X值中位. 
    (* (+ (caadr b) (caar b)) 0.5) 
    (* (- (caadr a) (caar a)) 0.5) ;误差=X差值的一半. 
    ) 
   (> (cadar a) (cadar b)) ;y值大者放前. 
   ) 
  (t (< (caar a)(caar b))) ;x值小者放前. 
  )))) tf-Lst)) 
  (setq tf-Lst (apply 'append tmp)) 
  ) 
;;;---------------------------------------------;;; 
;;; 函数sort_pt_lst测试程序（采用"函数Sort_pt_Lst.dwg"文件测试）: 
(defun c:tt (/ Lst pts ss str tmp) 
  (vl-cmdf "_.zoom" "_e") 
  (setq SS (ssget "x" '((0 . "LWPOLYLINE") (8 . "02")))) ;图中所有图幅边框. 
  (setq Lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))) 
  (setq pts (mapcar '(lambda(x / tmp) ;各图幅边框的(左下点 右上点). 
  (setq tmp (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget x)))) 
  (list (car tmp) (caddr tmp)) 
  ) Lst)) 
  (setq str (mapcar '(lambda(x / tmp) ;各图幅中标识字符（仅单个字符）. 
  (setq tmp (ssget "_c" (car x) (cadr x) '((0 . "TEXT")))) 
  (cdr (assoc 1 (entget (ssname tmp 0)))) 
  ) pts)) 
  (setq Lst (mapcar '(lambda(x y) (append x (list y))) pts str)) 
  (setq Lst (sort_pt_lst Lst)) 
  (mapcar 'caddr Lst) 
  ) 
;;;---------------------------------------------;;;

lxl217114 · 发表于 2025-6-18 08:59:52

谢谢分享原创代码

USER2128 · 发表于 2025-6-18 09:18:17

这种多个图幅的排序方式困扰了我很多年，偶获思路，特分享给有需要的人

qazxswk · 发表于 2025-6-18 13:59:24

嗯，这个不错，在批量打印中，图框打印顺序有用。

guosheyang · 发表于 2025-6-19 18:30:24

这个应该是图框分行处理按照最大的两个图框的y值范围分成上下两组然后分别排序再合并

USER2128 · 发表于 2025-6-20 10:55:23

本帖最后由 USER2128 于 2025-6-20 10:57 编辑

guosheyang 发表于 2025-6-19 18:30
这个应该是图框分行处理按照最大的两个图框的y值范围分成上下两组然后分别排序再合并

你说的是对的。
但仅采用常规排序函数排序后，其结果不尽人意。

guosheyang · 发表于 2025-6-20 11:32:08

本帖最后由 guosheyang 于 2025-6-20 18:15 编辑

USER2128 发表于 2025-6-20 10:55
你说的是对的。
但仅采用常规排序函数排序后，其结果不尽人意。

每组中先按 x值由小到大排列当x相同时再按照y值由大到小排这里的 x值相同否涉及到容差的设定而容差又可以计算每组中所有图框对（两两比较）起点（图框左下角点）坐标x值差的绝对值的最小值再加上1mm来确定

xyp1964 · 发表于 2025-6-21 12:06:16

USER2128 · 发表于 2025-6-21 16:26:00

xyp1964 发表于 2025-6-21 12:06

大佬的动画做出来就是牛！

xyp1964 · 发表于 2025-6-23 09:07:31

本帖最后由 xyp1964 于 2025-6-23 09:12 编辑

USER2128 发表于 2025-6-21 16:26
大佬的动画做出来就是牛！

;; 这样表达更合理

账号		自动登录	找回密码
密码			注册

[函数] 图框位置（图幅位置）排序函数

本帖子中包含更多资源

评分

本帖子中包含更多资源

评分

本帖子中包含更多资源

浏览过的版块