批量导出图纸中的块(批量wblock)

煮茗 · 发表于前天 20:50

原文件来自网络上，相信很多人都见过、用过。原代码如下：

; ----------------------------------------------------------------------
; (Wblocks all local block definitions to target path)
; Copyright (C) 2000 DotSoft, All Rights Reserved
; Website: http://www.dotsoft.com
; ----------------------------------------------------------------------
; DISCLAIMER: DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose. All materials are
; to be considered 慳s-is? and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
(defun c:wblockm ()
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;
(if (not dos_getdir)
(setq path (getstring "\nDS> Target Folder: " T))
(setq path (dos_getdir "Target Folder" (getvar "DWGPREFIX")))
)
(if (/= path nil)
(progn
(if (= (substr path (strlen path) 1) "\")
(setq path (substr path 1 (1- (strlen path))))
)
(princ "\nDS> Building List of Blocks ... ")
(setq lst nil)
(setq itm (tblnext "BLOCK" T))
(while (/= itm nil)
(setq nam (cdr (assoc 2 itm)))
(setq pass T)
(if (/= (cdr (assoc 1 itm)) nil)
(setq pass nil)
(progn
(setq ctr 1)
(repeat (strlen nam)
(setq chk (substr nam ctr 1))
(if (or (= chk "*")(= chk "|"))
(setq pass nil)
)
(setq ctr (1+ ctr))
)
)
)
(if (= pass T)
(setq lst (cons nam lst))
)
(setq itm (tblnext "BLOCK"))
)
(setq lst (acad_strlsort lst))
(princ "Done.")
;
(foreach blk lst
(setq fn (strcat path (chr 92) blk))
(if (findfile (strcat fn ".dwg"))
(command "_.WBLOCK" fn "_Y" blk)
(command "_.WBLOCK" fn blk)
)
)
)
)
;
(setvar "CMDECHO" cmdecho)
(princ)
)

; ---------------------------------------------------------------------- 
;          (Wblocks all local block definitions to target path) 
;            Copyright (C) 2000 DotSoft, All Rights Reserved 
;                   Website: http://www.dotsoft.com 
; ---------------------------------------------------------------------- 
; DISCLAIMER:  DotSoft Disclaims any and all liability for any damages 
; arising out of the use or operation, or inability to use the software. 
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims. 
; DotSoft makes no warranty, either expressed or implied, as to the 
; fitness of this product for a particular purpose.  All materials are 
; to be considered 慳s-is? and use of this software should be 
; considered as AT YOUR OWN RISK. 
; ---------------------------------------------------------------------- 
 
(defun c:wblockm () 
  (setq cmdecho (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  ; 
  (if (not dos_getdir) 
    (setq path (getstring "\nDS> Target Folder: " T)) 
    (setq path (dos_getdir "Target Folder" (getvar "DWGPREFIX"))) 
  ) 
  (if (/= path nil) 
    (progn 
      (if (= (substr path (strlen path) 1) "\") 
        (setq path (substr path 1 (1- (strlen path)))) 
      ) 
      (princ "\nDS> Building List of Blocks ... ") 
      (setq lst nil) 
      (setq itm (tblnext "BLOCK" T)) 
      (while (/= itm nil) 
        (setq nam (cdr (assoc 2 itm))) 
        (setq pass T) 
        (if (/= (cdr (assoc 1 itm)) nil) 
          (setq pass nil) 
          (progn 
            (setq ctr 1) 
            (repeat (strlen nam) 
              (setq chk (substr nam ctr 1)) 
              (if (or (= chk "*")(= chk "|")) 
                (setq pass nil) 
              ) 
              (setq ctr (1+ ctr)) 
            ) 
          ) 
        ) 
        (if (= pass T) 
          (setq lst (cons nam lst)) 
        ) 
        (setq itm (tblnext "BLOCK")) 
      ) 
      (setq lst (acad_strlsort lst)) 
      (princ "Done.") 
      ; 
      (foreach blk lst 
        (setq fn (strcat path (chr 92) blk)) 
        (if (findfile (strcat fn ".dwg")) 
          (command "_.WBLOCK" fn "_Y" blk) 
          (command "_.WBLOCK" fn blk) 
        ) 
      ) 
    ) 
  ) 
  ; 
  (setvar "CMDECHO" cmdecho) 
  (princ) 
)

不过原文件有缺点，就是没有加载doslib就无法选定目录，而要手输，麻烦得很。
还有就是原版是英文版。
小可抽空汉化，修改优化了一下，分享给大家。
1、目录设定在文件同目录下，【文件名_导出图块】文件夹；
2、增加数量提示；3、滤除标注箭头块。

老规矩，愿意打赏的可以直接下载LSP文件。

; ----------------------------------------------------------------------
; (Wblocks all local block definitions to target path)
; Copyright (C) 2000 DotSoft, All Rights Reserved
; Website: http://www.dotsoft.com
; ----------------------------------------------------------------------
; DISCLAIMER: DotSoft Disclaims any and all liability for any damages
; arising out of the use or operation, or inability to use the software.
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims.
; DotSoft makes no warranty, either expressed or implied, as to the
; fitness of this product for a particular purpose. All materials are
; to be considered 'as-is', and use of this software should be
; considered as AT YOUR OWN RISK.
; ----------------------------------------------------------------------
;;;2024-12-17
;;;Modified by 煮茗
(defun c:wblockm ()
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq lst nil)
(setq itm (tblnext "BLOCK" T))
(while (/= itm nil)
(setq nam (cdr (assoc 2 itm)))
(setq pass T)
(if (/= (cdr (assoc 1 itm)) nil)
(setq pass nil)
(progn
(setq ctr 1)
(repeat (strlen nam)
(setq chk (substr nam ctr 1))
(if (or (= chk "*")(= chk "|"))
(setq pass nil)
)
(setq ctr (1+ ctr))
)
)
)
(if (= pass T)
(setq lst (cons nam lst))
)
(setq itm (tblnext "BLOCK"))
)
(setq lst (acad_strlsort lst));排序
(setq bnum (length lst))
(princ (strcat "\n本图共有" (vl-princ-to-string bnum) "个块图元。"))
(setq BVL (getstring "\n是否导出这些图块（y/n）?【注意：标注箭头的图块将不导出。】<N>"))
(if (or (= BVL "Y")(= BVL "y"))
(progn
(setq path0 (GetVar "DwgPrefix"))
(setq Dir0 (vl-string-subst "_导出图块" ".dwg" (GetVar "DwgName")))
(setq path (strcat path0 Dir0))
(if (not (VL-FILE-DIRECTORY-P path))
(vl-mkdir path)
)
(if (= (substr path (strlen path) 1) "\")
(setq path (substr path 1 (1- (strlen path))))
)
(princ "\n请稍等，正在导出图块... \n")
(setq i 0)
(foreach blk lst
(if (and (/= blk "_ArchTick")(/= blk "_BoxBlank")(/= blk "_BoxFilled")(/= blk "_Closed")(/= blk "_ClosedBlank")(/= blk "_DatumBlank")(/= blk "_DatumFilled")(/= blk "_Dot")(/= blk "_DotBlank")(/= blk "_DotSmall")(/= blk "_Integral")(/= blk "_Oblique")(/= blk "_Open")(/= blk "_Open30")(/= blk "_Open90")(/= blk "_Origin")(/= blk "_Origin2")(/= blk "_Small"))
(progn
(setq fn (strcat path (chr 92) blk))
(if (findfile (strcat fn ".dwg"))
(command "_.WBLOCK" fn "_Y" blk)
(command "_.WBLOCK" fn blk)
)
(setq i (+ i 1))
)
)
)
(princ (strcat "\n操作完成。已导出" (vl-princ-to-string i) "个块图元。"))
(startapp "explorer" path)
)
)
(setvar "CMDECHO" cmdecho)
(princ)
)

; ---------------------------------------------------------------------- 
;          (Wblocks all local block definitions to target path) 
;            Copyright (C) 2000 DotSoft, All Rights Reserved 
;                   Website: http://www.dotsoft.com 
; ---------------------------------------------------------------------- 
; DISCLAIMER: DotSoft Disclaims any and all liability for any damages 
; arising out of the use or operation, or inability to use the software. 
; FURTHERMORE, User agrees to hold DotSoft harmless from such claims. 
; DotSoft makes no warranty, either expressed or implied, as to the 
; fitness of this product for a particular purpose. All materials are 
; to be considered 'as-is', and use of this software should be 
; considered as AT YOUR OWN RISK. 
; ---------------------------------------------------------------------- 
;;;2024-12-17 
;;;Modified by 煮茗 
 
(defun c:wblockm () 
  (setq cmdecho (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
(setq lst nil) 
      (setq itm (tblnext "BLOCK" T)) 
      (while (/= itm nil) 
        (setq nam (cdr (assoc 2 itm))) 
        (setq pass T) 
        (if (/= (cdr (assoc 1 itm)) nil) 
          (setq pass nil) 
          (progn 
            (setq ctr 1) 
            (repeat (strlen nam) 
              (setq chk (substr nam ctr 1)) 
              (if (or (= chk "*")(= chk "|")) 
                (setq pass nil) 
              ) 
              (setq ctr (1+ ctr)) 
            ) 
          ) 
        ) 
        (if (= pass T) 
          (setq lst (cons nam lst)) 
        ) 
        (setq itm (tblnext "BLOCK")) 
      ) 
      (setq lst (acad_strlsort lst));排序 
      (setq bnum (length lst)) 
          (princ (strcat "\n本图共有" (vl-princ-to-string bnum) "个块图元。")) 
          (setq BVL (getstring "\n是否导出这些图块（y/n）?【注意：标注箭头的图块将不导出。】<N>")) 
          (if (or (= BVL "Y")(= BVL "y")) 
      (progn 
          (setq path0 (GetVar "DwgPrefix")) 
      (setq Dir0 (vl-string-subst "_导出图块" ".dwg" (GetVar "DwgName"))) 
      (setq path (strcat path0 Dir0)) 
        (if (not (VL-FILE-DIRECTORY-P path)) 
          (vl-mkdir path) 
        ) 
      (if (= (substr path (strlen path) 1) "\") 
        (setq path (substr path 1 (1- (strlen path)))) 
      ) 
          (princ "\n请稍等，正在导出图块... \n") 
          (setq i 0) 
          (foreach blk lst 
          (if (and (/= blk "_ArchTick")(/= blk "_BoxBlank")(/= blk "_BoxFilled")(/= blk "_Closed")(/= blk "_ClosedBlank")(/= blk "_DatumBlank")(/= blk "_DatumFilled")(/= blk "_Dot")(/= blk "_DotBlank")(/= blk "_DotSmall")(/= blk "_Integral")(/= blk "_Oblique")(/= blk "_Open")(/= blk "_Open30")(/= blk "_Open90")(/= blk "_Origin")(/= blk "_Origin2")(/= blk "_Small")) 
          (progn 
        (setq fn (strcat path (chr 92) blk)) 
        (if (findfile (strcat fn ".dwg")) 
          (command "_.WBLOCK" fn "_Y" blk) 
          (command "_.WBLOCK" fn blk) 
        ) 
          (setq i (+ i 1)) 
          ) 
          ) 
          )          
      (princ (strcat "\n操作完成。已导出" (vl-princ-to-string i) "个块图元。")) 
          (startapp "explorer" path) 
          ) 
          ) 
  (setvar "CMDECHO" cmdecho) 
  (princ) 
)

moranyuyan · 发表于昨天 06:39

谢谢分享

w379106181 · 发表于昨天 08:31

感谢大神分享

by361973435 · 发表于昨天 08:34

感谢大神分享

czb203 · 发表于昨天 22:06

感谢大神分享

szhorse · 发表于昨天 22:18

感谢大佬从1970年穿越过来分享源码

gf123 · 发表于昨天 22:23

谢谢分享。。。

账号		自动登录	找回密码
密码			注册

批量导出图纸中的块(批量wblock)

本帖子中包含更多资源

评分