感谢版主们的鼓励，新手写了个小程序望指点

ysq101

newer 发表于 2013-9-12 20:56
在那个帖子里面，我都把程序给你写完了，建议也给你了，要想快，用矩阵变换，你在仔细看看那个程序，就简 ...

..慢慢来吧...先学好COMMAND先

zxq0220

2. (defun c:111()
   
3. (setvar "cmdecho" 0)
   
4.    ; 1 获取点位表
   
5. (setq ss (ssget '((0 . "LWPOLYLINE"))))
   
6. (if (< 300 (sslength ss))
   
7.   (exit (princ "\n所选对象太多"))
   
8. )
   
9. (setq lst-pt1 '()          ;建立空表
   
10.        lst-pt3 '()          ;建立空表
    
11.        i 0)
    
12. (repeat (sslength ss)      ;选择集长度
    
13.   (setq e1(ssname ss i))    ;返回第几个对象的图元名
    
14.   (setq s1 (vlax-ename->vla-object e1))
    
15.   (vla-getboundingbox s1 'minpoint 'maxpoint)
    
16.   (setq pt9 (vlax-safearray->list maxpoint)                       ;取得 右上角 点
    
17.         pt1 (reverse(cdr(reverse(vlax-safearray->list minpoint))));取得 左下角 点
    
18.         pt3 (list(car pt9)(cadr pt1))                             ;取得 右下角 点
    
19.         lst-pt1 (cons pt1 lst-pt1)      ;取得 左下角 点表  
    
20.         lst-pt3 (cons pt3 lst-pt3)      ;取得 右下角 点表
    
21.         i (1+ i))
    
22. )   ;end repeat
    
23. (setq lst-pt1 (reverse lst-pt1))
    
24. (setq lst-pt3 (reverse lst-pt3))
    
25. (command ".UNDO" "BE")
    
26.    ; 2 开始排位
    
27. (setq ss1 (ssadd))
    
28. (setq i 0)
    
29. (repeat (1- (sslength ss))
    
30.   (setq e1 (ssname ss i))    ;返回第几个对象的图元名
    
31.   (ssadd e1 ss1)            ;将它加到ss1选择集中
    
32.   (command "move" ss1 "" (nth i  lst-pt1)  (nth (setq i (1+ i)) lst-pt3))
    
33. );end repeat
    
34. (command ".UNDO" "e")
    
35. (princ "\n程序运行完毕")
    
36. (princ)
    
37. )   ;end defun
    

(defun c:111()<br /> (setvar "cmdecho" 0)<br />    ; 1 获取点位表<br /> (setq ss (ssget '((0 . "LWPOLYLINE"))))<br /> (if (< 300 (sslength ss))<br />   (exit (princ "\n所选对象太多"))<br /> )<br /> (setq lst-pt1 '()          ;建立空表<br />        lst-pt3 '()          ;建立空表<br />        i 0)<br /> (repeat (sslength ss)      ;选择集长度<br />   (setq e1(ssname ss i))    ;返回第几个对象的图元名<br />   (setq s1 (vlax-ename->vla-object e1))<br />   (vla-getboundingbox s1 'minpoint 'maxpoint)<br />   (setq pt9 (vlax-safearray->list maxpoint)                       ;取得 右上角 点<br />         pt1 (reverse(cdr(reverse(vlax-safearray->list minpoint))));取得 左下角 点<br />         pt3 (list(car pt9)(cadr pt1))                             ;取得 右下角 点<br />         lst-pt1 (cons pt1 lst-pt1)      ;取得 左下角 点表  <br />         lst-pt3 (cons pt3 lst-pt3)      ;取得 右下角 点表<br />         i (1+ i))<br /> )   ;end repeat<br /> (setq lst-pt1 (reverse lst-pt1))<br /> (setq lst-pt3 (reverse lst-pt3))<br /> (command ".UNDO" "BE")<br />    ; 2 开始排位<br /> (setq ss1 (ssadd))<br /> (setq i 0)<br /> (repeat (1- (sslength ss))<br />   (setq e1 (ssname ss i))    ;返回第几个对象的图元名<br />   (ssadd e1 ss1)            ;将它加到ss1选择集中<br />   (command "move" ss1 "" (nth i  lst-pt1)  (nth (setq i (1+ i)) lst-pt3))<br /> );end repeat<br /> (command ".UNDO" "e")<br /> (princ "\n程序运行完毕")<br /> (princ)<br /> )   ;end defun<br />

Free-Lancer

用 Move 这样写，循环太多了自然影响效率

1. (defun c:111 (/ ss i sl e pl bp)
   
2.   ;;获取实体的左下角点、右下角点
   
3.   (defun GetEntBox (e / obj p1 p2)
   
4.     (setq obj (vlax-ename->vla-object e))
   
5.     (vla-getboundingbox obj 'p1 'p2)
   
6.     (setq p1 (safearray-value p1)
   
7.           p2 (safearray-value p2)
   
8.     )
   
9.     (list p1 (list (car p2) (cadr p1) 0.))
   
10.   )
    
11.   (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    
12.     (progn
    
13.       (setq i  -1
    
14.             sl (sslength ss)
    
15.       )
    
16.       (repeat sl
    
17.         (setq e (ssname ss (setq i (1+ i))))
    
18.         (setq pl (getentbox e))
    
19.         (if (not bp)
    
20.           (setq bp (cadr pl));_第一次基点
    
21.           (progn
    
22.             (vl-cmdf
    
23.               ".move"
    
24.               (list e (car pl));_拾取实体表
    
25.               ""
    
26.               "_none"
    
27.               (car pl)
    
28.               "_none"
    
29.               bp
    
30.             )
    
31.             (setq bp (mapcar '+ bp (mapcar '- (cadr pl) (car pl))));_设置下一次的目标点
    
32.           )
    
33.         )
    
34.       )
    
35.     )
    
36.   )
    
37.   (princ)
    
38. )

(defun c:111 (/ ss i sl e pl bp)<br />   ;;获取实体的左下角点、右下角点<br />   (defun GetEntBox (e / obj p1 p2)<br />     (setq obj (vlax-ename->vla-object e))<br />     (vla-getboundingbox obj 'p1 'p2)<br />     (setq p1 (safearray-value p1)<br />           p2 (safearray-value p2)<br />     )<br />     (list p1 (list (car p2) (cadr p1) 0.))<br />   )<br />   (if (setq ss (ssget '((0 . "LWPOLYLINE"))))<br />     (progn<br />       (setq i  -1<br />             sl (sslength ss)<br />       )<br />       (repeat sl<br />         (setq e (ssname ss (setq i (1+ i))))<br />         (setq pl (getentbox e))<br />         (if (not bp)<br />           (setq bp (cadr pl));_第一次基点<br />           (progn<br />             (vl-cmdf<br />               ".move"<br />               (list e (car pl));_拾取实体表<br />               ""<br />               "_none"<br />               (car pl)<br />               "_none"<br />               bp<br />             )<br />             (setq bp (mapcar '+ bp (mapcar '- (cadr pl) (car pl))));_设置下一次的目标点<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

st788796

下一个的目标点是上一个的右下角点，cad命令接受选择集的都接受拾取，这个格式是(ent point)这个点是任意的

ysq101

Free-Lancer 发表于 2013-9-13 10:56
用 Move 这样写，循环太多了自然影响效率

我试试如何。。感谢了

ysq101

zxq0220 发表于 2013-9-13 08:26

谢谢你的帮助。。上次你也帮我写了一，这些又帮我优化

ysq101

Free-Lancer 发表于 2013-9-13 10:56
用 Move 这样写，循环太多了自然影响效率

高手就是高手。。。同样也用了COMMAND  
10000个对象处理起来也是很快的。。。。有空解剖你的程序{:soso_e113:}  看从中学到些什么不
感谢你的热心帮忙

ysq101

zxq0220 发表于 2013-9-13 08:26

用了CONS快了不少   
还有我为什么就没想到先把点表反转过来再MOVE处理呢
又想学到些东东了

newer

ysq101 发表于 2013-9-13 15:31
用了CONS快了不少   
还有我为什么就没想到先把点表反转过来再MOVE处理呢
又想学到些东东了

这不，你就学到了嘛。程序要多写，只看也不行。

ysq101

newer 发表于 2013-9-13 18:17
这不，你就学到了嘛。程序要多写，只看也不行。

谢谢鼓励...我会常写的

st788796

用 xdapi 就这样写

1. (defun c:tt (/ ss mat e box bp)
   
2.   (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
   
3.     (progn
   
4.       (setq mat (xdrx_matrix_identity 3))
   
5.       (xdrx_setsstodb ss 0)
   
6.       (while (setq e (xdrx_getentdata 0))
   
7.         (setq box (xdrx_entity_box e))
   
8.         (if bp
   
9.            (setq bp (list (caadr box) (cadar box) 0.))
   
10.            (progn
    
11.              (xdrx_entity_transform e (xdrx_matrix_settranslation mat (mapcar '- (car box) bp)))
    
12.              (setq bp (polar bp 0. (- (caadr box) (caar box)) ))
    
13.            )
    
14.         )
    
15.       )
    
16.      )
    
17.    )
    
18.   (princ)
    
19. )

(defun c:tt (/ ss mat e box bp)<br />   (if (setq ss (ssget '((0 . "LWPOLYLINE"))))<br />     (progn<br />       (setq mat (xdrx_matrix_identity 3))<br />       (xdrx_setsstodb ss 0)<br />       (while (setq e (xdrx_getentdata 0))<br />         (setq box (xdrx_entity_box e))<br />         (if bp<br />            (setq bp (list (caadr box) (cadar box) 0.))<br />            (progn<br />              (xdrx_entity_transform e (xdrx_matrix_settranslation mat (mapcar '- (car box) bp)))<br />              (setq bp (polar bp 0. (- (caadr box) (caar box)) ))<br />            )<br />         )<br />       )<br />      )<br />    )<br />   (princ)<br /> )

newer

st788796 发表于 2013-9-14 10:33
用 xdapi 就这样写

                               
登录/注册后可看大图

以前用API已经帮他写过一个了。

1. (defun c:tt()
   
2.    (if (and (setq ss (ssget))
   
3.             (setq pt (getpoint "\n插入点<退出>:"))
   
4.        )
   
5.       (progn
   
6.          (setq ss (XD::Pickset:TableSort ss 0 0 '< '<))
   
7.          (setq mat0 (xdrx_matrix_identity 3))
   
8.          (foreach n (apply 'append ss)
   
9.            (setq box (xdrx_entity_box n)
   
10.                  p1 (car box)
    
11.                  mat (xdrx_matrix_setTransLation mat0 (mapcar '- pt p1))
    
12.                  pt (mapcar '+ pt (list (distance p1 (cadr box)) 0 0)) ;;基点改为当前盒子的右下点，作为下一个盒子插入的基点，以便实体挨着
    
13.            )
    
14.            (xdrx_entity_transform n mat)            
    
15.            (apply 'xdrx_grdraw (cons 6 (cons 1 (xdrx_entity_box n)))) ;;品红画向量
    
16.          )
    
17.       )
    
18.    )
    
19.    (princ)
    
20. )
    

(defun c:tt()<br />    (if (and (setq ss (ssget))<br />             (setq pt (getpoint "\n插入点<退出>:"))<br />        )<br />       (progn<br />          (setq ss (XD::Pickset:TableSort ss 0 0 '< '<))<br />          (setq mat0 (xdrx_matrix_identity 3))<br />          (foreach n (apply 'append ss)<br />            (setq box (xdrx_entity_box n)<br />                  p1 (car box)<br />                  mat (xdrx_matrix_setTransLation mat0 (mapcar '- pt p1))<br />                  pt (mapcar '+ pt (list (distance p1 (cadr box)) 0 0)) ;;基点改为当前盒子的右下点，作为下一个盒子插入的基点，以便实体挨着<br />            )<br />            (xdrx_entity_transform n mat)             <br />            (apply 'xdrx_grdraw (cons 6 (cons 1 (xdrx_entity_box n)))) ;;品红画向量<br />          )<br />       )<br />    )<br />    (princ)<br /> )<br />

st788796

newer 发表于 2013-9-14 12:51
以前用API已经帮他写过一个了。

选个基准实体可能更好
楼主可能更追求纯V/Alisp,完全没必要

ysq101

st788796 发表于 2013-9-14 13:56
选个基准实体可能更好
楼主可能更追求纯V/Alisp,完全没必要

newer 确实帮我写了一个了
其实不是追求纯V/Alisp    只是新手想自己动手把自己的问题解决，不懂的再来请教大师们

ysq101

newer 发表于 2013-9-14 12:51
以前用API已经帮他写过一个了。

请教一下，如何才能达到按面积的大小的来排列呢？？

前提：不用API      不是不给力，是太给力，还没学会怎么用{:soso_e100:}