选择集生成图块

newer

1. (defun c:ss2blk (/ name lst ins blk)
   
2.   (vl-load-com)
   
3.   (or
   
4.     *acdoc*
   
5.     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
   
6.   )
   
7.   (or
   
8.     *blocks*
   
9.     (setq *blocks* (vla-get-Blocks *acdoc*))
   
10.   )
    
11.   (if (and
    
12.         (setq ss (ssget))
    
13.         (/= "" (setq name (getstring "\nEnter block name: ")))
    
14.         (progn
    
15.           (while (tblsearch "BLOCK" name)
    
16.             (setq name (getstring (strcat "\nA block named '" name "' already exists\nEnter block name: ")))
    
17.           )
    
18.           t
    
19.         )
    
20.         (setq ins (getpoint "\nSpecify insertion point: "))
    
21.       )
    
22.     (progn
    
23.       (vlax-for o (setq ss (vla-get-ActiveSelectionSet *acdoc*))
    
24.                 (setq lst (cons o lst))
    
25.       )
    
26.       (setq blk (vla-Add *blocks* (vlax-3d-point '(0. 0. 0.)) name))
    
27.       (setq lst (vlax-invoke *acdoc* 'CopyObjects lst blk))
    
28.       (foreach o lst
    
29.         (vla-move o (vlax-3d-point (trans ins 1 0)) (vlax-3d-point '
    
30.                                                                    (0. 0. 0.)
    
31.                                                     )
    
32.         )
    
33.       )
    
34.       (vla-erase ss)
    
35.       (vla-delete ss)
    
36.       (vl-cmdf ".insert" name ins "" "" "")
    
37.     )
    
38.   )
    
39.   (princ)
    
40. )
    
41. 
    
42. 
    

(defun c:ss2blk (/ name lst ins blk)<br />   (vl-load-com)<br />   (or<br />     *acdoc*<br />     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))<br />   )<br />   (or<br />     *blocks*<br />     (setq *blocks* (vla-get-Blocks *acdoc*))<br />   )<br />   (if (and<br />         (setq ss (ssget))<br />         (/= "" (setq name (getstring "\nEnter block name: ")))<br />         (progn<br />           (while (tblsearch "BLOCK" name)<br />             (setq name (getstring (strcat "\nA block named '" name "' already exists\nEnter block name: ")))<br />           )<br />           t<br />         )<br />         (setq ins (getpoint "\nSpecify insertion point: "))<br />       )<br />     (progn<br />       (vlax-for o (setq ss (vla-get-ActiveSelectionSet *acdoc*))<br />                 (setq lst (cons o lst))<br />       )<br />       (setq blk (vla-Add *blocks* (vlax-3d-point '(0. 0. 0.)) name))<br />       (setq lst (vlax-invoke *acdoc* 'CopyObjects lst blk))<br />       (foreach o lst<br />         (vla-move o (vlax-3d-point (trans ins 1 0)) (vlax-3d-point '<br />                                                                    (0. 0. 0.)<br />                                                     )<br />         )<br />       )<br />       (vla-erase ss)<br />       (vla-delete ss)<br />       (vl-cmdf ".insert" name ins "" "" "")<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> <br />

yshf

谢谢分享！！！

longer1000

谢谢分享！！！

yoyoho

谢谢分享！！！

kqqt6236

纯源码哦。

lisperado

(vl-cmdf ".insert" name ins "" "" "")

以上源代码连选取都已用VLISP，建议vla-insertblock应该更完美？
LM大师们都不建议command,vl-cmdf,command-s严重影响速度尤其批量！
除非无从选择。