批量合并图

zm880928

找到了，说一声，我也需要

liweitung

谢谢大侠奉献，但不建议合并图档。

aichong

谜你及源泉有这个功能

尘缘一生

• ;;批量目录图纸插入-----------【开始】---------
• (defun plins-dwg (/ e_lst ent fn files flis pt pt0 box d h h0 k0 i n str)
•   (_undo1)
•   (setq e_lst (sysvar '("osmode" "cmdecho" "filedia")))
•   (setvar "filedia" 0)
•   (setvar "cmdecho" 0)
•   (setvar "OSMODE" 0)
•   (vla-put-WindowState *ACAD* 2)  ;;CAD窗口最小化
•   (setq files (xl-div (sl-choose-files "" "dxf;*.dwg" (getvar "DWGPREFIX")) 10))
•   (vla-put-WindowState *ACAD* 1)  ;;CAD窗口最大化
•   (setq pt (getpoint "\n 请给出排图基点（左下角）？") k0 0.0)
•   (setq str (sl:do1ordo2 "插入形式为" "参照" "图块"))
•   (repeat (setq n (length files))
•     (setq pt0 (polar pt pi2 k0))
•     (setq flis (nth (setq n (1- n)) files) h0 0.0)
•     (repeat (setq i (length flis))
•       (setq fn (nth (setq i (1- i)) flis))
•       (if (= str "参照")
•         (command "-XREF" "A" fn pt0 1 1 0)
•         (vla-ins-b fn pt0 1 1 1 0)
•       )
•       (setq ent (entlast) box (ebox4 ent) d (- (car (caddr box)) (car (car box))) h (- (cadr (cadddr box)) (cadr (car box))))
•       (if (>= h h0) (setq h0 h))
•       (sl_subupd ent 10 pt0)
•       (setq pt0 (polar pt0 0 (* d 1.05)))
•       (if (= str "图块") (slexplode (entlast)))
•     )
•     (setq k0 (+ k0 (* h0 1.05)))
•   )
•   (command "zoom" "e")
•   (mapcar 'eval e_lst)
•   (_undo2)
•   (princ)
• )
  

链接：https://pan.baidu.com/s/1urFWFU-jDyiNYCOkaAISTg
提取码：qznf

ht1480

自己用的特简单
可选文件夹，块被分解，不想分解就把“*”去掉，粘贴到原坐标，原坐标重叠的话把插入点改改也行。
我也是抄抄改改大佬的函数和代码
分享是个良性循环

2. (defun C:xwj ()
   
3. (vl-load-com)
   
4.   (setq path (GXL-FILE-GETFOLDER))
   
5.   (setq file (VL-DIRECTORY-FILES path "*.dwg" 1))
   
6.   (foreach dwg file
   
7.     (command "insert" (strcat "*" path "\" dwg) '(0 0 0) 1 0)
   
8.     )
   
9. )
   
10. 
    
11. 
    
12. ;; (gxl-file-GetFolder "选择文件夹:") 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
    
13. (defun gxl-file-GetFolder (/ WinShell shFolder path catchit)
    
14.   (setq winshell (vlax-create-object "Shell.Application"))
    
15.   (setq        shFolder (vlax-invoke-method
    
16.                    WinShell 'BrowseForFolder 0 "选取文件夹" 1)
    
17.   )
    
18.   (setq
    
19.     catchit (vl-catch-all-apply
    
20.               '(lambda ()
    
21.                  (setq shFolder (vlax-get-property shFolder 'self))
    
22.                  (setq path (vlax-get-property shFolder 'path))
    
23.                )
    
24.             )
    
25.   )
    
26.   (if (vl-catch-all-error-p catchit)
    
27.     nil
    
28.     path
    
29.   )
    
30. )

(defun C:xwj ()<br /> (vl-load-com)<br />   (setq path (GXL-FILE-GETFOLDER))<br />   (setq file (VL-DIRECTORY-FILES path "*.dwg" 1))<br />   (foreach dwg file<br />     (command "insert" (strcat "*" path "\" dwg) '(0 0 0) 1 0)<br />     )<br /> )<br /> <br /> <br /> ;; (gxl-file-GetFolder "选择文件夹:") 返回值：字符串，文件夹路径，如果点了cancel, 返回nil<br /> (defun gxl-file-GetFolder (/ WinShell shFolder path catchit)<br />   (setq winshell (vlax-create-object "Shell.Application"))<br />   (setq        shFolder (vlax-invoke-method<br />                    WinShell 'BrowseForFolder 0 "选取文件夹" 1)<br />   )<br />   (setq<br />     catchit (vl-catch-all-apply<br />               '(lambda ()<br />                  (setq shFolder (vlax-get-property shFolder 'self))<br />                  (setq path (vlax-get-property shFolder 'path))<br />                )<br />             )<br />   )<br />   (if (vl-catch-all-error-p catchit)<br />     nil<br />     path<br />   )<br /> )

sowin

szhorse 发表于 2022-7-13 21:29
试试这个，发扬明经精神
来自网络，不知道哪位大神的，在此谢过
[face118.gif ...

这个好

seamopan

szhorse 发表于 2022-7-13 21:29
试试这个，发扬明经精神
来自网络，不知道哪位大神的，在此谢过
[face118.gif ...

这个能完美的合并不同图框大小的图纸，如果改为图框左下对齐然后去掉合并时加在图框外面的线框就更完美了！

473734642

ht1480 发表于 2022-7-19 12:46
自己用的特简单
可选文件夹，块被分解，不想分解就把“*”去掉，粘贴到原坐标，原坐标重叠的话把插入点改 ...

很好用，感谢大佬分享

zwf100

ht1480 发表于 2022-7-19 12:46
自己用的特简单
可选文件夹，块被分解，不想分解就把“*”去掉，粘贴到原坐标，原坐标重叠的话把插入点改 ...

代码好像哪里有误，运行不了

ht1480

zwf100 发表于 2023-1-12 21:09
代码好像哪里有误，运行不了

什么错误？
我自己用没有问题