如何删除一个已知块名的块？

vpddup

  如何删除一个已知块名的块？例如：我想删除名字为Axis-01块，用purge可以是可以，如下面的这个语句，但是这种语句多的话，执行好慢啊。还有什么更快的方法吗？ 谢谢。

• (command "-purge" "B" "Axis-01" "N")
  

liuhe

2. ;;36 [功能] 删除指定名的所有块
   
3. ;; (MJ:EraseBlock "BTL");删除名叫"BTL"的所有块
   
4. (defun MJ:EraseBlock (bn / layout i)
   
5.   (vlax-for layout *LOUTS*
   
6.     (vlax-for i (vla-get-block layout)
   
7.       (if (and
   
8.      (= (vla-get-objectname i) "AcDbBlockReference")
   
9.      (= (strcase (vla-get-name i)) (strcase bn))
   
10.    )
    
11. (vla-Delete i)
    
12.       )
    
13.     )
    
14.   )
    
15. )
    
16. 
    
17. ;;28.1 [功能] 清理打开文档
    
18. (defun MJ:PurgeAllDocs (/ item cur)
    
19.   (vlax-for item *DOCS*
    
20.     (vla-PurgeAll item)
    
21.   )
    
22. )
    
23. (LH:DELETETBLK "1")
    
24. ;;28.1 [功能] 清理打开文档BLK
    
25. (defun LH:DELETETBLK (BLK / item cur)
    
26.   (setq
    
27.     *ACAD* (vlax-get-acad-object)
    
28.     *DOC*  (vla-get-ActiveDocument *ACAD*)
    
29.     *BLKS* (vla-get-Blocks *DOC*)
    
30.   )
    
31.   (vlax-for item *BLKS*
    
32.     (IF        (= (VLA-GET-NAME ITEM) BLK)
    
33.       (PROGN
    
34.         (SETQ ERR (vl-catch-all-apply 'vla-delete (LIST item)))
    
35.         (IF (vl-catch-all-error-p ERR)
    
36.           (PROGN
    
37.             (PRINC (vl-catch-all-error-message ERR))
    
38.           )
    
39.         )
    
40.       )
    
41.     )
    
42.   )
    
43. )
    
44. (setq
    
45.       *ACAD*  (vlax-get-acad-object)
    
46.       *DOC*   (vla-get-ActiveDocument *ACAD*)
    
47.       *BLKS*  (vla-get-Blocks *DOC*)
    
48.       *LAYS*  (vla-get-Layers *DOC*)
    
49.       *LTS*   (vla-get-Linetypes *DOC*)
    
50.       *STS*   (vla-get-TextStyles *DOC*)
    
51.       *GRPS*  (vla-get-groups *DOC*)
    
52.       *DIMS*  (vla-get-DimStyles *DOC*)
    
53.       *LOUTS* (vla-get-Layouts *DOC*)
    
54.    
    
55. )
    
56. 
    

;;36 [功能] 删除指定名的所有块<br /> ;; (MJ:EraseBlock "BTL");删除名叫"BTL"的所有块<br /> (defun MJ:EraseBlock (bn / layout i)<br />   (vlax-for layout *LOUTS*<br />     (vlax-for i (vla-get-block layout)<br />       (if (and<br />      (= (vla-get-objectname i) "AcDbBlockReference")<br />      (= (strcase (vla-get-name i)) (strcase bn))<br />    )<br /> (vla-Delete i)<br />       )<br />     )<br />   )<br /> )<br /> <br /> ;;28.1 [功能] 清理打开文档<br /> (defun MJ:PurgeAllDocs (/ item cur)<br />   (vlax-for item *DOCS*<br />     (vla-PurgeAll item)<br />   )<br /> )<br /> (LH:DELETETBLK "1")<br /> ;;28.1 [功能] 清理打开文档BLK <br /> (defun LH:DELETETBLK (BLK / item cur)<br />   (setq<br />     *ACAD* (vlax-get-acad-object)<br />     *DOC*  (vla-get-ActiveDocument *ACAD*)<br />     *BLKS* (vla-get-Blocks *DOC*)<br />   )<br />   (vlax-for item *BLKS*<br />     (IF        (= (VLA-GET-NAME ITEM) BLK)<br />       (PROGN<br />         (SETQ ERR (vl-catch-all-apply 'vla-delete (LIST item)))<br />         (IF (vl-catch-all-error-p ERR)<br />           (PROGN<br />             (PRINC (vl-catch-all-error-message ERR))<br />           )<br />         )<br />       )<br />     )<br />   )<br /> )<br /> (setq<br />       *ACAD*  (vlax-get-acad-object)<br />       *DOC*   (vla-get-ActiveDocument *ACAD*)<br />       *BLKS*  (vla-get-Blocks *DOC*)<br />       *LAYS*  (vla-get-Layers *DOC*)<br />       *LTS*   (vla-get-Linetypes *DOC*)<br />       *STS*   (vla-get-TextStyles *DOC*)<br />       *GRPS*  (vla-get-groups *DOC*)<br />       *DIMS*  (vla-get-DimStyles *DOC*)<br />       *LOUTS* (vla-get-Layouts *DOC*)<br />     <br /> )<br /> <br />

飞雪神光

(setq ss(ssget "A" '((2 . "Axis-01"))))
(if ss(command "erase" ss ""))

xyp1964

(if(setq ss(ssget"x"'((2 . "Axis-01"))))(command"erase"ss""))

vpddup

liuhe 发表于 2023-4-2 16:19

可能我没有说清楚。我是想清理这个块。这个块已经从图面上删除了，但还在块定义库中。 我想把它从块库删除。

DELETEBLK 这个函数好使，能够实现这个想法。谢谢