■合并指定目录内的所有文件■ 源码
(defun c:mlpt (/ distx disty ent file files maxpoint minpoint path pmaxpmin 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
)
)
部分源码来自网络 在此谢过！
今天晚上逛了一个晚上的明经通道，收获很大，找到两个很好的lsp文件。尤其是这个程序，解决了困扰我很久的难题。经常要合并一些cad文件，二十几个甚至百多个，一个个的粘贴复制，是严重的体力活！！
刚才试用了下 效果很棒！ zhuquanmao 发表于 2020-5-30 22:56
有时候需要合并 有时候需要分割
受教了很实用 liuxiooang 发表于 2020-5-30 00:06
合并 有什么用处吗
有时候需要合并 有时候需要分割 太感谢了，谢谢，我想问下一下问题，，大家好，
(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”时有当前层时 命令执行关闭当前层
请楼主帮忙写下，在这里先谢谢了 先顶一下啦！回头有空再分析一下程序 这有一个很快的，不过有时会重叠
;批量插图（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 static/image/common/back.gif
有合并，那有没有拆分的呢？希望有啊。。
有拆分的 不过和定义的图框有关系 先顶一下啦！ 楼主太有才了 有创意 dwg里有相同名字而图元不一样的块就完蛋了