Vlisp的方法创建一个块，返回OBJ对象

9609759

分享一个自己写的一个用vlisp的方法，创建块的程序。
最稳定的创建块的方法，速度比command快很多！

2. ;测试代码
   
3. ;将对象转换成块
   
4. (defun c:tt ( / )
   
5.   (defun ss->ename (ss / x)  ;选择集转图元名的表
   
6.     (if ss
   
7.       (vl-remove-if-not  ;移除空的
   
8.         '(lambda (x)
   
9.           (= (type x) 'ename)  ;判断类型是否是图元名
   
10.         )
    
11.         (mapcar
    
12.           'cadr
    
13.           (ssnamex ss)    ;选择集改图元名
    
14.         )
    
15.       )
    
16.     )
    
17.   )
    
18.   (setq ss (ssget))
    
19.   (setq lst_ename (ss->ename ss))
    
20.   (setq pt (getpoint "请指定基点"))
    
21.   ;命令 创建块 ，并在in_pt处插入块 删除选择集  返回插入的块对象
    
22.   (setq obj (add_blocks lst_ename pt pt "*U" t))
    
23.   (alert (strcat "成功创建块："(vla-get-Name obj)))
    
24.   (princ)
    
25. )
    

;测试代码<br /> ;将对象转换成块<br /> (defun c:tt ( / )<br />   (defun ss->ename (ss / x)  ;选择集转图元名的表<br />     (if ss<br />       (vl-remove-if-not  ;移除空的<br />         '(lambda (x)<br />           (= (type x) 'ename)  ;判断类型是否是图元名<br />         )<br />         (mapcar<br />           'cadr<br />           (ssnamex ss)    ;选择集改图元名<br />         )<br />       )<br />     )<br />   )<br />   (setq ss (ssget))<br />   (setq lst_ename (ss->ename ss))<br />   (setq pt (getpoint "请指定基点"))<br />   ;命令 创建块 ，并在in_pt处插入块 删除选择集  返回插入的块对象<br />   (setq obj (add_blocks lst_ename pt pt "*U" t))<br />   (alert (strcat "成功创建块："(vla-get-Name obj)))<br />   (princ)<br /> )<br />

;----传入参数说明-----
; lst_ename : 图元名的表
; pt ：块的基点
; in_pt : 创建完后，插入的块的坐标 , 设置为nil时，只创建块集合对象，不插入块。返回这个块集合的对象！
; name  ： 块的名字  (名字为 "*U" 时，将创建匿名块)
; dele  ; 指定是否删除原有的对象 ，T or nil ,

;示例
;创建块 ，并在in_pt处插入块 删除选择集  返回插入后的块对象
;(add_blocks lst_ename pt in_pt "*U" t)

;创建块 ，并在in_pt处插入块 不删除选择集  返回插入后的块对象
;(add_blocks lst_ename pt in_pt "*U" nil)

;创建块 ，不删除选择集 不插入这个块，返回创建的块集合对象
;(add_blocks lst_ename pt nil "*U" nil)

9609759

感谢上面提供明经币的几位大哥，现在将代码直接附上！无需下载了

2. 
   
3. ;----传入参数说明-----
   
4. ; lst_ename : 图元名的表
   
5. ; pt ：块的基点
   
6. ; in_pt : 创建完后，插入的块的坐标 , 设置为nil时，只创建块集合对象，不插入块。返回这个块集合的对象！
   
7. ; name  ： 块的名字  (名字为 "*U" 时，将创建匿名块)
   
8. ; dele  ; 指定是否删除原有的对象 ，T or nil ,
   
9. 
   
10. 
    
11. 
    
12. ;创建块 ，并在in_pt处插入块 删除选择集  返回插入后的块对象
    
13. ;(add_blocks lst_ename pt in_pt "*U" t)
    
14. 
    
15. ;创建块 ，并在in_pt处插入块 不删除选择集  返回插入后的块对象
    
16. ;(add_blocks lst_ename pt in_pt "*U" nil)
    
17. 
    
18. ;创建块 ，不删除选择集 不插入这个块，返回创建的块集合对象
    
19. ;(add_blocks lst_ename pt nil "*U" nil)
    
20. 
    
21. (defun add_blocks (lst_ename pt in_pt name dele / arr lst_var modspe obj obj_block obj_doc pt1 x y)
    
22.         (if (and lst_ename pt name)
    
23.                 (progn
    
24.                         ;坐标转变体
    
25.                         (setq pt1 (vlax-3D-point pt))
    
26.                         ;图纸对象
    
27.                         (setq obj_doc (vla-get-ActiveDocument (vlax-get-acad-object)))
    
28.                         ;模型空间对象
    
29.                         (setq modspe (vla-get-modelspace obj_doc))
    
30.                         ;创建一个空的块
    
31.                         (setq obj_block (vla-Add (vla-get-Blocks obj_doc) pt1 name))
    
32.                         ;获取块名
    
33.                         (setq name (vla-get-Name obj_block))
    
34.                         ;图元名表转变体表
    
35.                         (setq lst_var (mapcar '(lambda(x)
    
36.                                                                                 (setq obj (vlax-ename->vla-object x))
    
37.                                                                                 (vlax-make-variant obj vlax-vbObject)
    
38.                                                                         )
    
39.                                                                         lst_ename
    
40.                                                 )
    
41.                         )
    
42.                         ;创建一个空的数组
    
43.                         (setq arr (vlax-make-safearray vlax-vbobject (cons 0 (- (length lst_var) 1))))
    
44.                         ;表装入数组
    
45.                         (setq arr (vlax-safearray-fill arr lst_var))
    
46.                         ;将数组对象复制到块内
    
47.                         (vla-CopyObjects obj_doc arr obj_block)
    
48.                         (if dele
    
49.                                 (progn
    
50.                                         ;删除原有的对象
    
51.                                         (mapcar '(lambda(y)
    
52.                                                                 (entdel y)
    
53.                                                         )
    
54.                                                                 lst_ename
    
55.                                         )
    
56.                                 )
    
57.                         )
    
58.                         (if in_pt
    
59.                                 (progn
    
60.                                         ;插入in_pt插入这个块
    
61.                                         (vla-InsertBlock modspe (vlax-3D-point in_pt) name 1 1 1 0)
    
62.                                 )
    
63.                                 obj_block
    
64.                         )
    
65.                 )
    
66.         )
    
67. )

<br /> ;----传入参数说明-----<br /> ; lst_ename : 图元名的表<br /> ; pt ：块的基点<br /> ; in_pt : 创建完后，插入的块的坐标 , 设置为nil时，只创建块集合对象，不插入块。返回这个块集合的对象！<br /> ; name  ： 块的名字  (名字为 "*U" 时，将创建匿名块)<br /> ; dele  ; 指定是否删除原有的对象 ，T or nil , <br /> <br /> <br /> <br /> ;创建块 ，并在in_pt处插入块 删除选择集  返回插入后的块对象<br /> ;(add_blocks lst_ename pt in_pt "*U" t)<br /> <br /> ;创建块 ，并在in_pt处插入块 不删除选择集  返回插入后的块对象<br /> ;(add_blocks lst_ename pt in_pt "*U" nil)<br /> <br /> ;创建块 ，不删除选择集 不插入这个块，返回创建的块集合对象<br /> ;(add_blocks lst_ename pt nil "*U" nil)<br /> <br /> (defun add_blocks (lst_ename pt in_pt name dele / arr lst_var modspe obj obj_block obj_doc pt1 x y)<br />         (if (and lst_ename pt name)<br />                 (progn<br />                         ;坐标转变体<br />                         (setq pt1 (vlax-3D-point pt))<br />                         ;图纸对象<br />                         (setq obj_doc (vla-get-ActiveDocument (vlax-get-acad-object)))<br />                         ;模型空间对象<br />                         (setq modspe (vla-get-modelspace obj_doc))<br />                         ;创建一个空的块<br />                         (setq obj_block (vla-Add (vla-get-Blocks obj_doc) pt1 name))<br />                         ;获取块名<br />                         (setq name (vla-get-Name obj_block))<br />                         ;图元名表转变体表<br />                         (setq lst_var (mapcar '(lambda(x)<br />                                                                                 (setq obj (vlax-ename->vla-object x))<br />                                                                                 (vlax-make-variant obj vlax-vbObject)<br />                                                                         )<br />                                                                         lst_ename<br />                                                 )<br />                         )<br />                         ;创建一个空的数组<br />                         (setq arr (vlax-make-safearray vlax-vbobject (cons 0 (- (length lst_var) 1))))<br />                         ;表装入数组<br />                         (setq arr (vlax-safearray-fill arr lst_var))<br />                         ;将数组对象复制到块内<br />                         (vla-CopyObjects obj_doc arr obj_block)<br />                         (if dele<br />                                 (progn<br />                                         ;删除原有的对象<br />                                         (mapcar '(lambda(y)<br />                                                                 (entdel y)<br />                                                         )<br />                                                                 lst_ename<br />                                         )<br />                                 )<br />                         )<br />                         (if in_pt<br />                                 (progn<br />                                         ;插入in_pt插入这个块<br />                                         (vla-InsertBlock modspe (vlax-3D-point in_pt) name 1 1 1 0)<br />                                 )<br />                                 obj_block<br />                         )<br />                 )<br />         )<br /> )

tomonkey239

学习了，感谢分享，大佬

yhly555

厉害，感谢分享！