■合并指定目录内的所有文件■ 源码

zhuquanmao · 发表于 2012-10-26 16:39

(defun c:mlpt (/ distx disty ent file files maxpoint minpoint path pmax
pmin pt1 pt2 sca
)
(command ".UNDO" "BE")
(setq sca (getvar "dimscale"))
(setq cmd (getvar "cmdecho"))
(setq oldos (getvar "OSMODE"))
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
(getstring "\n本程序将合并指定目录内的所有文件，执行速度较慢，请耐心等待。回车继续...")
(setq pt2 (getpoint "\n请选择插入点:"))
(setq path (browseforfolder "请选择要合并图纸的目录"))
(if (/= path nil)
(progn
(if (/= (substr path (strlen path) 1) "\")
(setq path (strcat path "\"))
)
(setq files (vl-directory-files path "*.dwg" 0))
(while files
(setq file (strcat path (car files)));;; (princ file)
;;; (princ "\n")
(command "-INSERT" file pt2 1 1 0)
(setq ent (entlast));;; (princ ent)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint)
pmin (vlax-safearray->list minpoint)
)
(setq distx (- (car pmax) (car pmin)))
(setq disty (- (cadr pmax) (cadr pmin)))
(setq pt1 (list (car pmax) (cadr pmin)))
(command "move" ent "" pt1 pt2)
(command "EXPLODE" ent "")
(setq pt2 (polar pt2 (/ pi 2) (+ disty (* 40 sca))))
(setq files (cdr files))
)
)
)
(setvar "OSMODE" oldos)
(setvar "CMDECHO" cmd)
(command ".UNDO" "E")
(princ)
)
;;; [功能] 以目录树方式浏览文件夹并返回路径
;;; [参数] msg---提示信息
;;; [返回] 文件夹路径，如果选择了cancel, 返回nil
;;; [测试] (browseforfolder "选择文件保存路径: ")
(defun browseforfolder (msg / shfolder path catchit)
(setq shfolder (vlax-invoke-method (vlax-create-object "Shell.Application")
'browseforfolder
(vlax-get-property
(vlax-get-acad-object)
'hwnd
) msg 1
)
catchit (vl-catch-all-apply '(lambda ()
(setq shfolder
(vlax-get-property shfolder
'self
)
path
(vlax-get-property shfolder
'path
)
)
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)

(defun c:mlpt (/ distx disty ent file files maxpoint minpoint path pmax 
          pmin pt1 pt2 sca 
       ) 
 
(command ".UNDO" "BE") 
  (setq sca (getvar "dimscale")) 
  (setq cmd (getvar "cmdecho")) 
  (setq oldos (getvar "OSMODE")) 
  (setvar "cmdecho" 0) 
  (setvar "OSMODE" 0) 
   (getstring "\n本程序将合并指定目录内的所有文件，执行速度较慢，请耐心等待。回车继续...") 
  (setq pt2 (getpoint "\n请选择插入点:")) 
  (setq path (browseforfolder "请选择要合并图纸的目录")) 
  (if (/= path nil) 
    (progn 
      (if (/= (substr path (strlen path) 1) "\") 
  (setq path (strcat path "\")) 
      ) 
      (setq files (vl-directory-files path "*.dwg" 0)) 
      (while files 
  (setq file (strcat path (car files)));;;  (princ file) 
;;;  (princ "\n") 
  (command "-INSERT" file pt2 1 1 0) 
  (setq ent (entlast));;;  (princ ent) 
  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint) 
  (setq pmax (vlax-safearray->list maxpoint) 
        pmin (vlax-safearray->list minpoint) 
  ) 
  (setq distx (- (car pmax) (car pmin))) 
  (setq disty (- (cadr pmax) (cadr pmin))) 
  (setq pt1 (list (car pmax) (cadr pmin))) 
  (command "move" ent "" pt1 pt2) 
  (command "EXPLODE" ent "") 
  (setq pt2 (polar pt2 (/ pi 2) (+ disty (* 40 sca)))) 
  (setq files (cdr files)) 
      ) 
    ) 
  ) 
  (setvar "OSMODE" oldos) 
  (setvar "CMDECHO" cmd) 
  (command ".UNDO" "E") 
  (princ) 
) 
 
;;; [功能] 以目录树方式浏览文件夹并返回路径 
;;; [参数] msg---提示信息 
;;; [返回] 文件夹路径，如果选择了cancel, 返回nil 
;;; [测试] (browseforfolder "选择文件保存路径: ") 
(defun browseforfolder (msg / shfolder path catchit) 
  (setq shfolder (vlax-invoke-method (vlax-create-object "Shell.Application") 
         'browseforfolder 
         (vlax-get-property 
       (vlax-get-acad-object) 
       'hwnd 
         ) msg 1 
   ) 
 catchit (vl-catch-all-apply '(lambda () 
           (setq shfolder 
          (vlax-get-property shfolder 
        'self 
          ) 
          path 
          (vlax-get-property shfolder 
        'path 
          ) 
           ) 
         ) 
  ) 
  ) 
  (if (vl-catch-all-error-p catchit) 
    nil 
    path 
  ) 
)

部分源码来自网络在此谢过！

zlq1318 · 发表于 2013-9-12 22:59

今天晚上逛了一个晚上的明经通道，收获很大，找到两个很好的lsp文件。尤其是这个程序，解决了困扰我很久的难题。经常要合并一些cad文件，二十几个甚至百多个，一个个的粘贴复制，是严重的体力活！！
刚才试用了下效果很棒！

liuxiooang · 发表于 2020-6-2 14:29

zhuquanmao 发表于 2020-5-30 22:56
有时候需要合并有时候需要分割

受教了很实用

zhuquanmao · 发表于 2020-5-30 22:56

liuxiooang 发表于 2020-5-30 00:06
合并有什么用处吗

有时候需要合并有时候需要分割

hehoubin · 发表于 2012-10-26 21:38

太感谢了，谢谢，我想问下一下问题，，大家好，
(DEFUN C:FL()
   (command ".-layer" "off" "bh" "")
   (command ".-layer" "off" "acx" "")
   (command ".-layer" "off" "a01" "")
   (command ".-layer" "off" "a02" "")
   (command ".-layer" "off" "a03" "")
   (command ".-layer" "off" "a04" "")
   (command ".-layer" "off" "a05" "")
   (command ".-layer" "off" "a06" "")
   (command ".-layer" "off" "a07" "")
   (command ".-layer" "off" "a08" "")
   (command ".-layer" "off" "a09" "")
   (command ".-layer" "off" "a10" "")
   (command ".-layer" "off" "a11" "")
   (command ".-layer" "off" "a12" "")
   (command ".-layer" "off" "a13" "")
   (command ".-layer" "off" "a14" "")
   (princ "\n ◆　a01--a14 已关闭")
(princ))
请问这个有简单的方法写吗？在加入当关闭图层“A01”~“A14”,“ACX”，“BH”时有当前层时命令执行关闭当前层
请楼主帮忙写下，在这里先谢谢了

teykmcqh · 发表于 2012-11-27 15:41

先顶一下啦！回头有空再分析一下程序

669423907 · 发表于 2012-11-27 21:21

这有一个很快的，不过有时会重叠

;批量插图（qfkxc）
(defun c:pc()
(setvar "CMDECHO" 0)
(setq pf (getfiled "指定原文件路径中的一个图形文件:>" "*" "dwg" 8))
(setq path (vl-filename-directory pf))
(setq path (strcat path "\\"))
(setq aa (vl-directory-files path "*.dwg" 1))
(setq n (length aa))
(setq i 0 nn 0)
(setq pp (nth i aa))
(sub1)
(princ))
(defun sub1 ()
(prompt "\n")
(prompt "程序正在解块插入图幅，请等待...\n")
(while (/= pp nil)
(setq i (+ i 1))
(setq pp (strcat path pp))
(setq pp (strcat "*" pp))
(command "insert" pp "0,0" "1" "")
(setq nn (+ nn 1))
(princ (strcat "第" (itoa nn) "幅" "图号为" pp " \r"))
(setq pp (nth i aa))
(setq pp (nth i aa)))
(command "zoom" "e" "zoom" "0.95x"))

freeok · 发表于 2012-11-29 21:05

有合并，那有没有拆分的呢？希望有啊。。

zhuquanmao · 发表于 2012-12-2 20:12

freeok 发表于 2012-11-29 21:05
有合并，那有没有拆分的呢？希望有啊。。

有拆分的不过和定义的图框有关系

yaokui25 · 发表于 2012-12-9 20:23

先顶一下啦！

longer1000 · 发表于 2012-12-20 16:08

楼主太有才了

有123 · 发表于 2012-12-23 11:39

有创意

pzweng · 发表于 2013-1-19 13:46

dwg里有相同名字而图元不一样的块就完蛋了

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

■合并指定目录内的所有文件■ 源码

点评