pickset:sort-by-row

说明:图元列表按“行”蛇形排序，适合车位、桩位等成排布置的对象。nsspts: 图元列表或选择集。nrowtol: 同一排的 y 容差(默认 1200)，取对象深度的一半左右。nminrow: 一行数量达到该值才算“成排”(默认 5)并参与换向。nreturn: 排序后的图元列表。n说明: 按包围盒中心分行(有些块插入点不在块上)，成排的行内按 x 排序，n 第 1 排从左到右、整排后换向，形成蛇形；n 不足 minrow 的零星图元(墙边单列等)排在最后，按 x 分列从左到右、列内自上而下。

用法:

 (pickset:sort-by-row sspts rowtol minrow)

参数:1 sspts : 未识别定义;2 rowtol : 未识别定义;3 minrow : 未识别定义;

返回值:图元列表

示例:

(pickset:sort-by-row (ssget '((0 . "INSERT"))) 1200 5)

(defun pickset:sort-by-row (sspts rowtol minrow / items rows cur cury main loose tmp dir res)
  "图元列表按“行”蛇形排序，适合车位、桩位等成排布置的对象。\nsspts: 图元列表或选择集。\nrowtol: 同一排的 y 容差(默认 1200)，取对象深度的一半左右。\nminrow: 一行数量达到该值才算“成排”(默认 5)并参与换向。\nreturn: 排序后的图元列表。\n说明: 按包围盒中心分行(有些块插入点不在块上)，成排的行内按 x 排序，\n      第 1 排从左到右、整排后换向，形成蛇形；\n      不足 minrow 的零星图元(墙边单列等)排在最后，按 x 分列从左到右、列内自上而下。"
  "图元列表"
  "(pickset:sort-by-row (ssget '((0 . \"INSERT\")))
    1200 5)"
  (if (p:picksetp sspts)
    (setq sspts (pickset:to-list sspts)))
  (setq rowtol (if (numberp rowtol)
      rowtol 1200.0)
    minrow (if (numberp minrow)
      minrow 5))
  (setq items (mapcar (quote (lambda (x / bx p)
          (setq bx (vl-catch-all-apply (quote entity:getbox)
              (list x 0)))
          (if (and bx (listp bx)
              (cadr bx))
            (list x (/ (+ (car (car bx))
                  (car (cadr bx)))
                2.0)
              (/ (+ (cadr (car bx))
                  (cadr (cadr bx)))
                2.0))
            (progn (setq p (entity:getdxf x 10))
              (list x (car p)
                (cadr p))))))
      sspts))
  (setq items (vl-sort items (quote (lambda (a b)
          (> (caddr a)
            (caddr b))))))
  (setq rows nil cur nil cury nil)
  (foreach it items (if (and cur (<= (abs (- cury (caddr it)))
          rowtol))
      (setq cur (cons it cur))
      (progn (if cur (setq rows (cons (cons cury (reverse cur))
              rows)))
        (setq cur (list it)
          cury (caddr it)))))
  (if cur (setq rows (cons (cons cury (reverse cur))
        rows)))
  (setq rows (reverse rows))
  (setq main nil loose nil)
  (foreach r rows (if (>= (length (cdr r))
        minrow)
      (setq main (cons r main))
      (setq loose (append loose (cdr r)))))
  (setq main (vl-sort main (quote (lambda (a b)
          (> (car a)
            (car b))))))
  (setq dir 1 res nil)
  (foreach r main (setq cur (vl-sort (cdr r)
        (quote (lambda (a b)
            (< (cadr a)
              (cadr b))))))
    (if (= dir -1)
      (setq cur (reverse cur)))
    (setq res (append res (mapcar (quote car)
          cur)))
    (setq dir (- dir)))
  (setq tmp nil)
  (foreach it loose (setq tmp (cons (list (fix (/ (+ (cadr it)
                50.0)
              100.0))
          (- (caddr it))
          (car it))
        tmp)))
  (setq tmp (vl-sort tmp (quote (lambda (a b)
          (if (= (car a)
              (car b))
            (< (cadr a)
              (cadr b))
            (< (car a)
              (car b)))))))
  (append res (mapcar (quote caddr)
      tmp)))

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

pickset:sort-by-row

上传记录