求助大神帮忙修改成闭合多段线也能排版，（下面代码只能排矩形框）

296715530

(defun c:pb (/ ent i j lst1 lst2 maxpoint minpoint name name1 name2 os1 panban1 pbjj1 pmax pmin pt1x pt1y

pt2x pt2y pt3x
               pt3y pt4x pt4y ptn ss )
  (defun juxingguolv (ss / ent i j lst1 lst2 maxpoint minpoint name name1 name2 pmax pmin pt1x pt1y pt2x

pt2y pt3x pt3y
                         pt4x pt4y )                       ; 过滤掉矩形选择集内的矩形子函数
    (setq lst1 '())
    (repeat (setq i (sslength ss))
      (setq name (ssname ss (setq i (1- i))))
      (vla-getboundingbox (vlax-ename->vla-object name) 'minpoint 'maxpoint)
      (setq pmax (vlax-safearray->list maxpoint)  pmin (vlax-safearray->list minpoint))
      (setq lst1 (cons (list pmin pmax name) lst1))
    )
    (setq lst2 lst1)
    (repeat (setq i (length lst1))
      (setq name (nth (setq i (1- i)) lst1))
      (setq pt1x (car (car name))  pt1y (cadr (car name))  pt2x (car (cadr name))
            pt2y (cadr (cadr name))  name1 (caddr name) )
      (repeat (setq j (length lst2))
        (setq ent (nth (setq j (1- j))  lst2 ))
        (setq pt3x (car (car ent))  pt3y (cadr (car ent)) pt4x (car (cadr ent))
              pt4y (cadr (cadr ent))   name2 (caddr ent))
        (if (and (> pt3x pt1x) (> pt3y pt1y)  (< pt4x pt2x) (< pt4y pt2y))
          (if (ssmemb name2 ss)  (setq ss (ssdel name2 ss))))
        (if (and (< pt3x pt1x) (< pt3y pt1y) (> pt4x pt2x)(> pt4y pt2y))
          (if (ssmemb name1 ss) (setq ss (ssdel name1 ss))))))
    ss
  )
  (vl-load-com)
  (command "UNDO" "be")
  (setq os1 (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "CMDECHO" 0)
  (setvar "nomutt" 1)
  (princ "\n选择一个外图框对象以指定外框图层：")
  (if (setq ss (ssget ":S" (list '(0 . "LWPOLYLINE") '(90 . 4))))
    (progn
      (setq ent (entget (ssname ss 0)))
      (princ (strcat "\n选定的外图框图层名是：" (cdr (assoc 8 ent))))
      (princ ",请选择要排版的所有(图框)对象：")
      (if (setq ss (ssget (list '(0 . "LWPOLYLINE") '(90 . 4) (assoc 8 ent))))
        (progn
          (setvar "nomutt" 0)
          (setq ss (juxingguolv ss))
          (or pbjj (setq pbjj 100.0))
          (or paiban (setq paiban "X") )
          (if (setq pbjj1 (getdist (strcat "\n请输入图纸排版间距或直接量取：<" (rtos pbjj 2 2) ">:")))
            (setq pbjj pbjj1))
          (if (member (setq panban1 (strcase (getstring (strcat "\n请选择排版方向[横向(X)/纵向(Y)]：<"

paiban ">")))) '("X" "Y"))
            (setq paiban panban1))
          (if (setq ptn (getpoint "\n指定一点做为排版的新起点位置(注意尽量远离选择的图形区域)："))
            (progn
              (repeat (setq i (sslength ss))
                (setq name (ssname ss (setq i (1- i))))
                (vla-getboundingbox (vlax-ename->vla-object name) 'minpoint 'maxpoint)
                (setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))
                (command "move" (ssget "_c" pmin pmax) "" pmin ptn)
                (cond
                  ((= paiban "X") (setq ptn (list (+ (car ptn) (- (car pmax) (car pmin)) pbjj) (cadr

ptn))))
                  ((= paiban "Y") (setq ptn (list (car ptn) (+ (cadr ptn) (- (cadr pmax) (cadr pmin))

pbjj)))))))))))
  )
  (setvar "nomutt" 0)
  (command "UNDO" "e")
  (setvar "cmdecho" 1)
  (setvar "osmode" os1)
  (princ)
)

296715530

写不完的日记

你这个排版要超出你的母版

296715530

矩形框可以排，非矩形框(多段线框)和框里面的图元会留在原地不动，

liwen888888

不规则图形用CAD插件不是很好，其实有很多专业的排板套料软件可以选择啊

love1030312

自动排版  可没那么容易实现哟

296715530

love1030312 发表于 2019-12-11 08:27
自动排版  可没那么容易实现哟

我用ngc的工具箱，可以实现自动排窗线

296715530

此贴问题终结，感谢热心人

999999

支持支持&#128522;，，回去用用

2496653555

(defun c:bn (/ ent i j lst1 lst2 maxpoint minpoint namM namM1 namM2 os1 panban1 pbjj1 pmax pmin pt1x pt1y
pt2x pt2y pt3x pt3y pt4x pt4y ptn ss )

  (defun juxingguolv (ss / ent i j lst1 lst2 maxpoint minpoint nam name1 name2 pmax pmin pt1x pt1y pt2x
                                    pt2y pt3x pt3y pt4x pt4y )    ; 过滤掉矩形选择集内的矩形子函数 nam
    (setq lst1 '())
    (repeat (setq i (sslength ss))
      (setq nam (ssname ss (setq i (1- i))))
      (vla-getboundingbox (vlax-ename->vla-object nam) 'minpoint 'maxpoint)
      (setq pmax (vlax-safearray->list maxpoint)  pmin (vlax-safearray->list minpoint))
      (setq lst1 (cons (list pmin pmax nam) lst1))
    )
    (setq lst2 lst1)
    (repeat (setq i (length lst1))
      (setq nam (nth (setq i (1- i)) lst1))
      (setq pt1x (car (car nam))  pt1y (cadr (car nam))  pt2x (car (cadr nam))
            pt2y (cadr (cadr nam))  name1 (caddr nam) )
      (repeat (setq j (length lst2))
        (setq ent (nth (setq j (1- j))  lst2 ))
        (setq pt3x (car (car ent))  pt3y (cadr (car ent)) pt4x (car (cadr ent))
              pt4y (cadr (cadr ent))   name2 (caddr ent))
        (if (and (> pt3x pt1x) (> pt3y pt1y)  (< pt4x pt2x) (< pt4y pt2y))
          (if (ssmemb name2 ss)  (setq ss (ssdel name2 ss))))
        (if (and (< pt3x pt1x) (< pt3y pt1y) (> pt4x pt2x)(> pt4y pt2y))
          (if (ssmemb name1 ss) (setq ss (ssdel name1 ss))))))
    ss
  )
  (vl-load-com)
  (command "UNDO" "be")
  (setq os1 (getvar "osmode"))
  (setvar "osmode" 0)
  (setvar "CMDECHO" 0)
  (setvar "nomutt" 1)
  (princ "请选择要排版的所有(图框)对象：");取消了选外框
(setq ss (ssget (list '(0 . "LWPOLYLINE")  ))) ;'(90 . 4)(assoc 8 ent)
        (progn
          (setvar "nomutt" 0)
          (setq ss (juxingguolv ss))
          (or pbjj (setq pbjj 100.0))
          (or paiban (setq paiban "X") )
          (if (setq pbjj1 (getdist (strcat "\n请输入图纸排版间距或直接量取：<" (rtos pbjj 2 2) ">:")))
            (setq pbjj pbjj1))
       (if (member (setq panban1 (strcase (getstring (strcat "\n请选择排版方向[横向(X)/纵向(Y)]：<"paiban ">")))) '("X" "Y"))
            (setq paiban panban1))
          (if (setq ptn (getpoint "\n指定一点做为排版的新起点位置(注意尽量远离选择的图形区域)："))
            (progn
              (repeat (setq i (sslength ss))
                (setq namm (ssname ss (setq i (1- i))))
                (vla-getboundingbox (vlax-ename->vla-object namm) 'minpoint 'maxpoint)
                (setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))
                (command "move" (ssget "_c" pmin pmax) "" pmin ptn)
                (cond
                  ((= paiban "X") (setq ptn (list (+ (car ptn) (- (car pmax) (car pmin)) pbjj) (cadr

ptn))))
                  ((= paiban "Y") (setq ptn (list (car ptn) (+ (cadr ptn) (- (cadr pmax) (cadr pmin))

pbjj)))))))) ;)))
  )
  (setvar "nomutt" 0)
  (command "UNDO" "e")
  (setvar "cmdecho" 1)
  (setvar "osmode" os1)
  (princ)
)