AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
[分享]LEE-MAC的刪除圖塊LISP Oo-2-110 [分享]LEE-MAC的刪除圖塊LISP Ia15010 [分享]LEE-MAC的刪除圖塊LISP Ziao1510 [分享]LEE-MAC的刪除圖塊LISP BPl3tjj [分享]LEE-MAC的刪除圖塊LISP Uos15010 [分享]LEE-MAC的刪除圖塊LISP Uos15011

[分享]LEE-MAC的刪除圖塊LISP

向下

[分享]LEE-MAC的刪除圖塊LISP Empty [分享]LEE-MAC的刪除圖塊LISP

發表 由 RyanGuo 于 2013-07-09, 09:26

分享前先來幾個刪除圖塊相關討論連結:

1.非作用中的圖塊刪除使用PURGE即可刪除
 [已解決]如何刪除圖塊??
http://www.autocad-tw.com/t12338-topic

2.PURGE刪不掉的圖塊可能是藏在別的圖塊中
[已解決]請問block圖塊清除的問題
http://www.autocad-tw.com/t970-topic

3.PURGE刪不掉的圖塊可能是標註的自訂箭頭
[已解決]怎麼樣都刪不掉也找不到的圖塊。
http://www.autocad-tw.com/t2123-topic

以上不管刪得掉還是刪不掉的圖塊都可以用LEE-MAC的刪除圖塊一次刪除.
http://www.lee-mac.com/deleteblocks.html

然而,
要完全刪除圖塊對LEE-MAC的刪除圖塊來說卻有個盲點,
那便是匿名圖塊,下面是匿名圖塊的相關討論.


  • 少量的匿名圖塊

可以使用shenhung前輩的匿名塊和實名塊的轉換程式,
名字換成實名後就想怎樣就怎樣吧= =+
http://www.autocad-tw.com/t15417-topic#104470


  • 大量的匿名圖塊

理想的解決方案請見下面的討論.
 [已解決]圖檔有3MB,打開卻沒東西
http://www.autocad-tw.com/t15507-topic

以上,
願各位的圖檔中不會存在著刪不掉的圖塊了.

最後補上LEE-MAC的刪除圖塊V1.0備份檔案
(下載請優先到LEE-MAC網站下載,或許會有更新的版本).
Spoiler(用來隱藏帖子內容):
;;--------------------=={ Delete Blocks }==-------------------;;
;;                                                            ;;
;;  Displays a dialog interface prompting the user to select  ;;
;;  blocks to be deleted and proceeds to remove all traces of ;;
;;  selected blocks from the drawing.                         ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    14-07-2012                            ;;
;;                                                            ;;
;;  First Release.                                            ;;
;;------------------------------------------------------------;;

(defun c:delblocks ( / *error* del lst )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (cond
        (   (null (setq lst (LM:GetBlockNames)))
            (princ "\nNo Blocks found in Drawing.")
        )
        (   (null (setq lst (LM:ListBox "Select Blocks to Delete" lst t)))
            (princ "\n*Cancel*")
        )
        (   t
            (LM:startundo (LM:acdoc))
            (setq del  (LM:DeleteBlocks (LM:acdoc) lst))
            (vla-regen (LM:acdoc) acallviewports)
            (foreach block lst
                (if (member (strcase block) del)
                    (princ (strcat "\nDeleted block " block "."))
                    (princ (strcat "\nUnable to delete block " block "."))
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )    
    (princ)
)
        
;;--------------------=={ Delete Blocks }==-------------------;;
;;                                                            ;;
;;  Deletes all references of a list of blocks from a drawing ;;
;;  (including nested references, nested to any level).       ;;
;;  Proceeds to delete the associated block definitions from  ;;
;;  the drawing, if possible.                                 ;;
;;                                                            ;;
;;  This function is compatible with ObjectDBX.               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  docobj - VLA Document Object                              ;;
;;  blocks - List of blocks to be deleted, (case insensitive) ;;
;;------------------------------------------------------------;;
;;  Returns:  List of blocks that were successfully deleted.  ;;
;;------------------------------------------------------------;;

(defun LM:DeleteBlocks ( docobj blocks / blk lst out )
    (setq blk (vla-get-blocks docobj))
    (if (setq blocks
            (mapcar 'strcase
                (vl-remove-if
                    (function
                        (lambda ( name )
                            (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list blk name)))
                        )
                    )
                    blocks
                )
            )
        )
        (progn
            (vlax-for layer (vla-get-layers docobj)
                (if (eq :vlax-true (vla-get-lock layer))
                    (progn
                        (setq lst (cons layer lst))
                        (vla-put-lock layer :vlax-false)
                    )
                )
            )
            (vlax-for def blk
                (vlax-for obj def
                    (if
                        (and
                            (eq "AcDbBlockReference" (vla-get-objectname obj))
                            (or
                                (and
                                    (vlax-property-available-p obj 'effectivename)
                                    (member (strcase (vla-get-effectivename obj)) blocks)
                                )
                                (member (strcase (vla-get-name obj)) blocks)
                            )
                        )
                        (vl-catch-all-apply 'vla-delete (list obj))
                    )
                )
            )
            (foreach block blocks
                (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list (vla-item blk block)))))
                    (setq out (cons block out))
                )
            )
            (foreach layer lst (vla-put-lock layer :vlax-true))
            (reverse out)
        )
    )
)

;;-----------------------=={ List Box }==---------------------;;
;;                                                            ;;
;;  Displays a List Box allowing the user to make a selection ;;
;;  from the supplied data.                                   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  title    - List Box Dialog title                          ;;
;;  lst      - List of Strings to display in the List Box     ;;
;;  multiple - Boolean flag to determine whether the user     ;;
;;             may select multiple items (T=Allow Multiple)   ;;
;;------------------------------------------------------------;;
;;  Returns:  List of selected items, else nil.               ;;
;;------------------------------------------------------------;;

(defun LM:ListBox ( title lst multiple / dch des tmp res )
    (cond
        (   (not
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (write-line
                        (strcat
                            "listbox : dialog { label = \""
                            title
                            "\"; spacer; : list_box { key = \"list\"; multiple_select = "
                            (if multiple "true" "false")
                            "; } spacer; ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   t     
            (start_list "list")
            (foreach item lst (add_list item))
            (end_list)
            (setq res (set_tile "list" "0"))
            (action_tile "list" "(setq res $value)")
            (setq res
                (if (= 1 (start_dialog))
                    (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" res ")")))
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    res
)

;; Get Block Names  -  Lee Mac
;; Returns an alphabetically sorted list of block names,
;; excluding anonymous and xref-dependent blocks.

(defun LM:GetBlockNames ( / bd bl )
    (while (setq bd (tblnext "BLOCK" (null bd)))
        (if (zerop (logand 125 (cdr (assoc 70 bd))))
            (setq bl (cons (cdr (assoc 2 bd)) bl))
        )
    )
    (vl-sort bl '<)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'UNDOCTL)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns a global pointer to the VLA Active Document Object

(defun LM:acdoc nil
    (cond ( acdoc ) ((setq acdoc (vla-get-activedocument (vlax-get-acad-object)))))
)

;;------------------------------------------------------------;;

(vl-load-com) (princ)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;


Tiger&蘋果爸 寫到:讚啦!! 謝謝熱心分享~< 積分 +1>
[公告]關於團隊成員的回文及貢獻
RyanGuo
RyanGuo
初級會員
初級會員

文章總數 : 206
年齡 : 36
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 3565
威望值 : 304
注冊日期 : 2013-04-18
男 射手座 狗

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 Tiger&蘋果爸 于 2013-07-09, 09:52

好精采的圖塊文章整理,對於有困擾的朋友幫助很大喔~
微笑 

____________________________________________________________________________________
[分享]LEE-MAC的刪除圖塊LISP Oo-2-110 [分享]LEE-MAC的刪除圖塊LISP Ia15010 [分享]LEE-MAC的刪除圖塊LISP Ziao1510 [分享]LEE-MAC的刪除圖塊LISP BPl3tjj
Tiger&蘋果爸
Tiger&蘋果爸
系統管理員
系統管理員

文章總數 : 18447
年齡 : 43
來自 : 台北市文山區
職業 : AutoCAD顧問
愛好 : 蹓狗/戶外活動/拍照
個性 : 幽默/樂觀/善良
使用年資 : 15↑
使用版本 : AutoCAD 2016
經驗值 : 71283
威望值 : 13614
注冊日期 : 2008-04-23
2D基礎函授 2D進階函授 3D基礎函授 https://i.servimg.com/u/f11/19/71/67/71/2d3d10.png2D+3D線上 顧問外掛程式 經典問與答讀者 藍鵲1號
2009聚會勳章 2010聚會勳章 2011聚會勳章 2012聚會勳章 2013勳章-2D基礎 2014聚會勳章 2015聚會勳章 2016聚會勳章 串連貼紙成功 男 水瓶座 兔

http://mypaper.pchome.com.tw/kv1012tiger

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 judyyai 于 2013-07-09, 12:34

讚~應該列為精華文章~
真的沒甚麼圖塊刪不掉了傻笑 

____________________________________________________________________________________
[分享]LEE-MAC的刪除圖塊LISP Eai-1a11 [分享]LEE-MAC的刪除圖塊LISP Ia15010 [分享]LEE-MAC的刪除圖塊LISP Ziao110 [分享]LEE-MAC的刪除圖塊LISP BPl3tjj
judyyai
judyyai
管理顧問
管理顧問

文章總數 : 7668
年齡 : 41
來自 : 台南
職業 : 機械製圖
愛好 : 電腦相關
個性 : think too much...
使用年資 : 10↑
使用版本 : AC2014(開始於2015九月底)
AutoCAD基礎篇等級 : 10星級
積分 : 392
最佳解答 : 1
經驗值 : 27909
威望值 : 3478
發帖精華 : 2
回帖精華 : 4
注冊日期 : 2008-11-19
2D基礎函授 3D基礎函授 顧問外掛程式 經典問與答讀者 藍鵲2號
2009聚會勳章 串連貼紙成功 女 巨蟹座 蛇

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的圖塊刪除LISP

發表 由 RyanGuo 于 2013-07-09, 13:16

多謝兩位前輩的誇獎,
我只是在分享這LISP前剛好爬文有爬到這些,
順便一起整理出來而已@@a
RyanGuo
RyanGuo
初級會員
初級會員

文章總數 : 206
年齡 : 36
來自 : 屏東
職業 : 機械繪圖
愛好 : 玩遊戲
個性 : 嗚嗚男
使用年資 : 1年多
使用版本 : 2011
積分 : 3
經驗值 : 3565
威望值 : 304
注冊日期 : 2013-04-18
男 射手座 狗

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 蔣秉澔 于 2013-11-08, 13:57

這支lisp,不只兇,還很狠,搭配shenhung前輩的lisp,簡直是大絕,呵呵
蔣秉澔
蔣秉澔
初級會員
初級會員

文章總數 : 211
年齡 : 42
來自 : 嘉義市
職業 : 大電力系統設計、製程、檢測
愛好 : 電腦相關,出遊踏青
個性 : 待人隨和,對事執著
使用年資 : 8年
使用版本 : 2011 Electrical,2014
積分 : 4
經驗值 : 3378
威望值 : 162
注冊日期 : 2013-08-31
顧問外掛程式 藍鵲661號
男 金牛座 蛇

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 safardy 于 2013-11-10, 14:04

認同 太好了!!!
感覺非常實用~馬上來清除圖面的渣!!
辛苦了
safardy
safardy
一般會員
一般會員

文章總數 : 30
年齡 : 32
來自 : 台北市
職業 : 室內設計
愛好 : 旅遊
個性 : 腦殘
使用年資 : 2年
使用版本 : 2013
經驗值 : 2601
威望值 : 24
注冊日期 : 2012-10-02
藍鵲639號 女 獅子座 虎

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 Monkey.D 于 2015-04-29, 19:18

清圖時常遇到這類的問題,救星出現 感動
Monkey.D
Monkey.D
一般會員
一般會員

文章總數 : 44
年齡 : 33
來自 : 嘉義
職業 : Auto Cad
愛好 : 待業
個性 : 交朋友
使用年資 : 1
使用版本 : 新手初學
經驗值 : 2859
威望值 : 12
注冊日期 : 2012-03-19
男 處女座 牛

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 et1029et 于 2015-05-07, 11:31

感謝分享圖塊刪除大全
受用無窮啊 感激
et1029et
et1029et
初級會員
初級會員

文章總數 : 356
年齡 : 38
來自 : 桃園
職業 : 行政繪圖
愛好 : 學習
個性 : 隨和
使用年資 : 新手初學
使用版本 : 2013
積分 : 4
經驗值 : 3924
威望值 : 324
注冊日期 : 2013-07-02
藍鵲666號
女 天蝎座 猴

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 naruto018 于 2017-04-08, 09:16

感謝分享
受用無窮
naruto018
naruto018
中級會員
中級會員

文章總數 : 149
年齡 : 27
來自 : 高雄
職業 : 學習中(CAD,Revit,Excel VBA)
愛好 : 當個懶熊
個性 : 內向
使用年資 : 新手
使用版本 : 2015
AutoCAD基礎篇等級 : 10星級
積分 : 5
經驗值 : 1939
威望值 : 299
注冊日期 : 2016-11-29
藍鵲726號
男 摩羯座 羊

回頂端 向下

[分享]LEE-MAC的刪除圖塊LISP Empty 回復: [分享]LEE-MAC的刪除圖塊LISP

發表 由 李幸笛 于 2018-08-28, 17:44

感謝分享
李幸笛
李幸笛
一般會員
一般會員

文章總數 : 32
年齡 : 43
來自 : 新北市
職業 : 待業
愛好 : 看書
個性 : 開朗
使用年資 : 4年
使用版本 : cad 2012
經驗值 : 3034
威望值 : 0
注冊日期 : 2011-07-13
女 摩羯座 兔

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
[分享]LEE-MAC的刪除圖塊LISP Uos15011 [分享]LEE-MAC的刪除圖塊LISP Uos15010 [分享]LEE-MAC的刪除圖塊LISP BPl3tjj [分享]LEE-MAC的刪除圖塊LISP Ziao1510 [分享]LEE-MAC的刪除圖塊LISP Ia15010 [分享]LEE-MAC的刪除圖塊LISP Oo-2-110