图纸排列

iLisp · 发表于 2014-9-17 04:54:13

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

看到一个很有用的程序演示，哪位给实现下！

lucas3 · 发表于 2014-9-17 08:06:36

你现在图框大小一样，还好说，很多情况下图框大小不一样，

csharp · 发表于 2014-9-17 08:42:29

那就一样大的排一起

Lisphk · 发表于 2014-9-17 09:24:08

这功能比较好，常用，盼高手解决。

Miss^M · 发表于 2014-9-17 09:35:04

略吊啊,望楼主共享

st788796 · 发表于 2014-9-18 08:07:58

这个局限性很强，可以提供个简单排列，具体应用的时候在加约束条件即可

XDSoft · 发表于 2014-9-18 08:47:25

st788796 发表于 2014-9-18 08:07
这个局限性很强，可以提供个简单排列，具体应用的时候在加约束条件即可

通用的话，可以提高两个工具，一个是只运行几次的拾取边界设置的，拾取后可以把实体类型什么的保存起来。这样，不变的情况下，就读这个设置来找边界来进行处理。

lucas3 · 发表于 2014-9-18 09:04:17

我觉得应该按图号从左至右，从上至下排序，设定列数，行距，列距后重排，楼主这个，只是对齐，中间还有空的，空出来没意义吧，另外还要考虑到大小图框的问题，上传个文档供测试

csharp · 发表于 2014-9-18 09:59:34

最大框应该有特征，如块、特定层线，如果是块里面有属性还可以提取属性作为排序的约束条件，最基本的就是构造框选集，遍历求box，根据box特征分组，每个组再用框去排行列，最后移动完成

lucas3 · 发表于 2014-9-18 13:43:35

csharp 发表于 2014-9-18 09:59
最大框应该有特征，如块、特定层线，如果是块里面有属性还可以提取属性作为排序的约束条件，最基本的就是构 ...

图框一般都用块或属性块

eachy · 发表于 2014-9-19 11:31:53

先写个行对齐的

(defun c:tt (/ ss dis ptl firstBox v)
(if (and (setq e (car (xdrx_entsel "\nPick Insert: " '((0 . "INSERT")))))
(setq dis (getdist "\nSpace Dist: "))
(progn
(princ "\n选择范围<回车全选>.....")
(setq filter (list (assoc 2 (entget e))))
(if (not (setq ss (ssget filter)))
(setq ss (ssget "x" filter))
ss
)
)
)
(progn
(setq ptl (mapcar 'xdrx_entity_box (xdrx_pickset->ents ss))
ptl (vl-sort ptl
'(lambda (x1 x2)
(if (equal (caar x1) (caar x2) 1e-3)
(> (cadar x1) (cadar x2))
(< (caar x1) (caar x2))
)
)
)
firstBox (car ptl)
v (mapcar '- (caddr firstBox) (car firstBox))
ptl (XD::List:TableSort
(mapcar '(lambda (x)
(list
(last x) ;_左上角
(last x)
(cadr x) ;_右下角
)
)
ptl
)
0
3
(car v) ;_行以高度为误差
)
)
(mapcar '(lambda (x / row basePnt position basePnt baseBox)
(setq row (mapcar 'cdr x)
baseBox (car row)
basePnt (car baseBox)
position (mapcar
'(lambda (a b)
(setq
basePnt (polar
basePnt
0.
(+ dis
(- (caadr a) (caar a))
)
)
)
)
row
(cdr row)
)
)
(mapcar '(lambda (a b)
(if (setq ss (ssget "C" (car a) (cadr a)));_不可有重叠
(progn
(xdrx_entity_move
ss
(car a)
b
)
)
)
)
(cdr row)
position
)
)
ptl
)
)
)
(princ)
)

(defun c:tt (/ ss dis ptl firstBox v) 
  (if (and (setq e (car (xdrx_entsel "\nPick Insert: " '((0 . "INSERT"))))) 
           (setq dis (getdist "\nSpace Dist: ")) 
           (progn 
             (princ "\n选择范围<回车全选>.....") 
             (setq filter (list (assoc 2 (entget e)))) 
             (if (not (setq ss (ssget filter))) 
               (setq ss (ssget "x" filter)) 
               ss 
             ) 
           ) 
      ) 
    (progn 
      (setq ptl             (mapcar 'xdrx_entity_box (xdrx_pickset->ents ss)) 
            ptl             (vl-sort ptl 
                              '(lambda (x1 x2) 
                                 (if (equal (caar x1) (caar x2) 1e-3) 
                                   (> (cadar x1) (cadar x2)) 
                                   (< (caar x1) (caar x2)) 
                                 ) 
                               ) 
                     ) 
            firstBox (car ptl) 
            v             (mapcar '- (caddr firstBox) (car firstBox)) 
            ptl             (XD::List:TableSort 
                       (mapcar '(lambda        (x) 
                                  (list 
                                    (last x) ;_左上角 
                                    (last x) 
                                    (cadr x) ;_右下角 
                                  ) 
                                ) 
                               ptl 
                       ) 
                       0 
                       3 
                       (car v) ;_行以高度为误差 
                     ) 
      ) 
      (mapcar '(lambda (x / row basePnt position basePnt baseBox) 
                 (setq row        (mapcar 'cdr x) 
                       baseBox        (car row) 
                       basePnt        (car baseBox)                                        
                       position        (mapcar 
                                  '(lambda (a b) 
                                     (setq 
                                       basePnt (polar 
                                                 basePnt 
                                                 0. 
                                                 (+ dis 
                                                    (- (caadr a) (caar a)) 
                                                 ) 
                                               ) 
                                     ) 
                                   ) 
                                  row 
                                  (cdr row) 
                                ) 
                 ) 
                 (mapcar '(lambda (a b) 
                            (if        (setq ss (ssget "C" (car a) (cadr a)));_不可有重叠 
                              (progn 
                                (xdrx_entity_move 
                                  ss 
                                  (car a) 
                                  b 
                                ) 
                              ) 
                            ) 
                          ) 
                         (cdr row) 
                         position 
                 ) 
               ) 
              ptl 
      ) 
    ) 
  ) 
  (princ) 
)

csharp · 发表于 2014-9-19 12:22:45

eachy 发表于 2014-9-19 11:31
先写个行对齐的

行与行间没有处理

lucas3 · 发表于 2014-9-19 22:13:55

csharp 发表于 2014-9-19 12:22
行与行间没有处理

楼主去哪儿呢？提了问题就不管呢？

eachy · 发表于 2014-9-20 09:40:14

csharp 发表于 2014-9-19 12:22
行与行间没有处理

补充几句,列之间大小不一致时还没有想好怎么处理

(defun c:tt (/ ss dis ptl firstBox v maxHeightL nl nnl)
(if (and (setq e (car (xdrx_entsel "\nPick Insert: " '((0 . "INSERT")))))
(setq dis (getdist "\nSpace Dist: "))
(progn
(princ "\n选择范围<回车全选>.....")
(setq filter (list (assoc 2 (entget e))))
(if (not (setq ss (ssget filter)))
(setq ss (ssget "x" filter))
ss
)
)
)
(progn
(setq ptl (mapcar 'xdrx_entity_box (xdrx_pickset->ents ss))
ptl (vl-sort ptl
'(lambda (x1 x2)
(if (equal (caar x1) (caar x2) 1e-3)
(> (cadar x1) (cadar x2))
(< (caar x1) (caar x2))
)
)
)
firstBox (car ptl)
v (mapcar '- (caddr firstBox) (car firstBox))
ptl (mapcar '(lambda (a) (mapcar 'cdr a))
(XD::List:TableSort
(mapcar '(lambda (x)
(list
(last x) ;_左上角
(last x)
(cadr x) ;_右下角
)
)
ptl
)
0
3
(car v) ;_行以高度为误差
)
)
maxHeightL (mapcar
'(lambda (x)
(+ dis
(apply
'max
(mapcar
'cadr
(mapcar
'(lambda (a)
(apply 'mapcar (cons '- a))
)
x
)
)
)
)
)
ptl
)
nnl (reverse maxHeightL)
)
(mapcar '(lambda (x)
(setq nL (cons (apply '+ nnl) nL)
nnl (cdr nnl)
)
)
maxHeightL
)
(mapcar '(lambda (x y / start basePnt position basePnt baseBox)
(setq baseBox (car x)
basePnt (car baseBox)
basepnt (list (car basePnt) y 0.)
start basepnt
position (mapcar
'(lambda (a b)
(setq
basePnt (polar
basePnt
0.
(+ dis
(- (caadr a) (caar a))
)
)
)
)
x
(cdr x)
)
)
(mapcar '(lambda (a b)
(if (setq ss (ssget "C" (car a) (cadr a))) ;_不可有重叠
(progn
(xdrx_entity_move
ss
(car a)
b
)
)
)
)
x
(cons start position)
)
)
ptl
(mapcar '(lambda (b)
(- (cadr (caaar ptl)) b)
)
(cons 0.0 nl)
)
)
)
)
(princ)
)

(defun c:tt (/ ss dis ptl firstBox v maxHeightL nl nnl) 
  (if (and (setq e (car (xdrx_entsel "\nPick Insert: " '((0 . "INSERT"))))) 
           (setq dis (getdist "\nSpace Dist: ")) 
           (progn 
             (princ "\n选择范围<回车全选>.....") 
             (setq filter (list (assoc 2 (entget e)))) 
             (if (not (setq ss (ssget filter))) 
               (setq ss (ssget "x" filter)) 
               ss 
             ) 
           ) 
      ) 
    (progn 
      (setq ptl               (mapcar 'xdrx_entity_box (xdrx_pickset->ents ss)) 
            ptl               (vl-sort        ptl 
                                '(lambda (x1 x2) 
                                   (if (equal (caar x1) (caar x2) 1e-3) 
                                     (> (cadar x1) (cadar x2)) 
                                     (< (caar x1) (caar x2)) 
                                   ) 
                                 ) 
                       ) 
            firstBox   (car ptl) 
            v               (mapcar '- (caddr firstBox) (car firstBox)) 
            ptl               (mapcar '(lambda (a) (mapcar 'cdr a)) 
                               (XD::List:TableSort 
                                 (mapcar '(lambda (x) 
                                            (list 
                                              (last x) ;_左上角 
                                              (last x) 
                                              (cadr x) ;_右下角 
                                            ) 
                                          ) 
                                         ptl 
                                 ) 
                                 0 
                                 3 
                                 (car v) ;_行以高度为误差 
                               ) 
                       ) 
            maxHeightL (mapcar 
                         '(lambda (x) 
                            (+ dis 
                               (apply 
                                 'max 
                                 (mapcar 
                                   'cadr 
                                   (mapcar 
                                     '(lambda (a) 
                                        (apply 'mapcar (cons '- a)) 
                                      ) 
                                     x 
                                   ) 
                                 ) 
                               ) 
                            ) 
                          ) 
                         ptl 
                       ) 
            nnl               (reverse maxHeightL) 
      ) 
      (mapcar '(lambda (x) 
                 (setq nL  (cons (apply '+ nnl) nL) 
                       nnl (cdr nnl) 
                 ) 
               ) 
              maxHeightL 
      ) 
      (mapcar '(lambda (x y / start basePnt position basePnt baseBox) 
                 (setq baseBox        (car x) 
                       basePnt        (car baseBox) 
                       basepnt        (list (car basePnt) y 0.) 
                       start        basepnt 
                       position        (mapcar 
                                  '(lambda (a b) 
                                     (setq 
                                       basePnt (polar 
                                                 basePnt 
                                                 0. 
                                                 (+ dis 
                                                    (- (caadr a) (caar a)) 
                                                 ) 
                                               ) 
                                     ) 
                                   ) 
                                  x 
                                  (cdr x) 
                                ) 
                 ) 
                 (mapcar '(lambda (a b) 
                            (if        (setq ss (ssget "C" (car a) (cadr a))) ;_不可有重叠 
                              (progn 
                                (xdrx_entity_move 
                                  ss 
                                  (car a) 
                                  b 
                                ) 
                              ) 
                            ) 
                          ) 
                         x 
                         (cons start position) 
                 ) 
               ) 
              ptl 
              (mapcar '(lambda (b) 
                         (- (cadr (caaar ptl)) b) 
                       ) 
                      (cons 0.0 nl) 
              ) 
      ) 
    ) 
  ) 
  (princ) 
)

iLisp · 发表于 2014-9-20 10:26:57

竖向也对齐就好了，形成 Net 格一样

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

[编程申请] 图纸排列

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评